Paso 3- Trayectorias de hospitalización y mortalidad con foco en condiciones vinculadas a trastornos de salud mental y consumo de sustancias posterior a un primer ingreso por alguno de estos trastornos, en usuarios/as jóvenes y adultos emergentes de población general y pertenecientes a pueblos originarios, 2018-2021, Chile (actualización)

Distintas secuencias: Trimestral y Mensual, con y sin censura; Seleccionar algoritmos para generar las matrices de agrupación, ver opciones de algoritmos de agrupamiento (jerárquico o por medoids); ver un rango de opciones de distinta cantidad de conglomerados.

Configurar

# remover objetos y memoria utilizada
rm(list=ls());gc()

          used (Mb) gc trigger (Mb) max used (Mb)
Ncells  601474 32.2    1286502 68.8  1088566 58.2
Vcells 1153039  8.8    8388608 64.0  1947095 14.9

if(Sys.info()["sysname"]=="Windows"){
 folder_path <- ifelse(dir.exists("H:/Mi unidad/PERSONAL ANDRES/UCH_salud_publica/asignaturas/un_inv_II/"),
                       "H:/Mi unidad/PERSONAL ANDRES/UCH_salud_publica/asignaturas/un_inv_II/",
                       "C:/Users/CISS Fondecyt/Mi unidad/Alvacast/SISTRAT 2022 (github)/_proposal_grant/2023/")
} else {folder_path <- getwd()}
load(paste0(folder_path,"20240902_25.RData"))

Paquetes estadísticos

#elegir repositorio
if(Sys.info()["sysname"]=="Windows"){
  options(repos = c(CRAN = "https://cran.dcc.uchile.cl/"))
}
options(install.packages.check.source = "yes") # Chequea la fuente de los paquetes

#borrar caché
#system("fc-cache -f -v")

if(!require(pacman)){install.packages("pacman");require(pacman)}

pacman::p_unlock(lib.loc = .libPaths()) #para no tener problemas reinstalando paquetes

if(Sys.info()["sysname"]=="Windows"){
if (getRversion() != "4.4.1") { stop("Requiere versión de R 4.4.1. Actual: ", getRversion()) }
}

if(!require(kableExtra)){install.packages("kableExtra");require(kableExtra)}
if(!require(tidyverse)){install.packages("tidyverse");require(tidyverse)}
if(!require(cluster)){install.packages("cluster"); require(cluster)}
if(!require(WeightedCluster)){install.packages("WeightedCluster"); require(WeightedCluster)}
if(!require(devtools)){install.packages("devtools"); require(devtools)}
if(!require(TraMineR)){install.packages("TraMineR"); require(TraMineR)}
if(!require(TraMineRextras)){install.packages("TraMineRextras"); require(TraMineRextras)}
if(!require(NbClust)){install.packages("NbClust"); require(NbClust)}
if(!require(haven)){install.packages("haven"); require(haven)}
if(!require(ggseqplot)){install.packages("ggseqplot"); require(ggseqplot)}
if(!require(gridExtra)){install.packages("gridExtra"); require(gridExtra)}
if(!require(Tmisc)){install.packages("Tmisc"); require(Tmisc)}
if(!require(factoextra)){install.packages("factoextra"); require(factoextra)}
#remotes::install_version("htmltools", "0.5.2")

#pacman job kableExtra tidyverse cluster WeightedCluster devtools TraMineR TraMineRextras NbClust haven ggseqplot gridExtra Tmisc factoextra reticulate  withr rmarkdown quarto

options(knitr.kable.NA = '')


#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:

knitr::knit_hooks$set(time_it = local({
  now <- NULL
  function(before, options) {
    if (before) {
      # record the current time before each chunk
      now <<- Sys.time()
    } else {
      # calculate the time difference after a chunk
      res <- ifelse(difftime(Sys.time(), now)>(60^2),difftime(Sys.time(), now)/(60^2),difftime(Sys.time(), now)/(60^1))
      # return a character string to show the time
      x<-ifelse(difftime(Sys.time(), now)>(60^2),paste("Tiempo que demora esta sección:", round(res,1), "horas"),paste("Tiempo que demora esta sección:", round(res,1), "minutos"))
      paste('<div class="message">', gsub('##', '\n', x),'</div>', sep = '\n')
    }
  }
}))
knitr::opts_chunk$set(time_it = TRUE)

#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:

format_cells <- function(df, rows ,cols, value = c("italics", "bold", "strikethrough")){
  
  # select the correct markup
  # one * for italics, two ** for bold
  map <- setNames(c("*", "**", "~~"), c("italics", "bold", "strikethrough"))
  markup <- map[value]  
  
  for (r in rows){
    for(c in cols){
      
      # Make sure values are not factors
      df[[c]] <- as.character( df[[c]])
      
      # Update formatting
      df[r, c] <- ifelse(nchar(df[r, c])==0,"",paste0(markup, gsub(" ", "", df[r, c]), markup))
    }
  }
  
  return(df)
}
#To produce line breaks in messages and warnings
knitr::knit_hooks$set(
  error = function(x, options) {
    paste('\n\n<div class="alert alert-danger">',
          gsub('##', '\n', gsub('^##\ Error', '**Error**', x)),
          '</div>', sep = '\n')
  },
  warning = function(x, options) {
    paste('\n\n<div class="alert alert-warning">',
          gsub('##', '\n', gsub('^##\ Warning:', '**Warning**', x)),
          '</div>', sep = '\n')
  },
  message = function(x, options) {
    paste('<div class="message">',
          gsub('##', '\n', x),
          '</div>', sep = '\n')
  }
)

#_#_#_#_#_#_#_#_#_#_#_#_#_
invisible("Function to format CreateTableOne into a database")

as.data.frame.TableOne <- function(x, ...) {capture.output(print(x,
                                                                 showAllLevels = TRUE, varLabels = T,...) -> x)
  y <- as.data.frame(x)
  y$characteristic <- dplyr::na_if(rownames(x), "")
  y <- y %>%
    fill(characteristic, .direction = "down") %>%
    dplyr::select(characteristic, everything())
  rownames(y) <- NULL
  y}
#_#_#_#_#_#_#_#_#_#_#_#_#_
# Austin, P. C. (2009). The Relative Ability of Different Propensity 
# Score Methods to Balance Measured Covariates Between 
# Treated and Untreated Subjects in Observational Studies. Medical 
# Decision Making. https://doi.org/10.1177/0272989X09341755
smd_bin <- function(x,y){
  z <- x*(1-x)
  t <- y*(1-y)
  k <- sum(z,t)
  l <- k/2
  
  return((x-y)/sqrt(l))
  
}


#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:


#duración en cada estado
seq_mean_t<- function(bd=NULL, group= group){
  resultados<- by(bd, group, seqmeant)
  
  do.call(rbind, lapply(names(resultados), function(name) {
    data.frame(factor_inclusivo = name, resultados[[name]])
  }))
}


seqtrate_t<- function(bd=NULL, group= group){
    # Utilizar la función 'by' para calcular las tasas agrupadas por 'glosa_sexo'
    resultados <- by(bd, 
                     group, 
                     seqtrate)
    
    # Convertir los resultados en un data frame en formato largo
    resultados_long <- do.call(rbind, lapply(names(resultados), function(sexo) {
      df <- as.data.frame(resultados[[sexo]])
      df$from <- rownames(df)
      df$glosa_sexo <- sexo
      df
    }))
    
    # Usar tidyr para convertir a formato largo
    library(tidyr)
    resultados_long <- pivot_longer(resultados_long, 
                                    cols = -c(from, glosa_sexo), 
                                    names_to = "to", 
                                    values_to = "rate")
    
    # Mostrar el data frame final
    print(resultados_long)
}


seqcount_t<- function(bd=NULL, group= group){
    # Utilizar la función 'by' para calcular las tasas agrupadas por 'glosa_sexo'
  resultados <- by(bd, 
                   group, 
                   function(x) seqtrate(x, count = TRUE))
    
    # Convertir los resultados en un data frame en formato largo
    resultados_long <- do.call(rbind, lapply(names(resultados), function(sexo) {
      df <- as.data.frame(resultados[[sexo]])
      df$from <- rownames(df)
      df$glosa_sexo <- sexo
      df
    }))
    
    # Usar tidyr para convertir a formato largo
    library(tidyr)
    resultados_long <- pivot_longer(resultados_long, 
                                    cols = -c(from, glosa_sexo), 
                                    names_to = "to", 
                                    values_to = "count")
    
    # Mostrar el data frame final
    print(resultados_long)
}
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:


if(.Platform$OS.type == "windows") withAutoprint({
  memory.size()
  memory.size(TRUE)
  memory.limit()
})

> memory.size()

[1] Inf
> memory.size(TRUE)

[1] Inf
> memory.limit()

[1] Inf

if(Sys.info()["sysname"]=="Windows"){memory.limit(size=56000)}

[1] Inf

Agregamos un estado de mortalidad para distinguirlo de otros tipos de censura. Por mientras, lo dejaré en otra base.

ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens_d <- ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens_d <- ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens

for(i in 59:1) {
  ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens_d <- ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens_d %>%
    dplyr::mutate(!!as.character(i) := ifelse(ceiling(death_time) <= i, "cens", !!sym(as.character(i))))
}
for(i in 19:1) {
  ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens_d <- ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens_d %>%
    dplyr::mutate(!!as.character(i) := ifelse(ceiling(death_time) <= i, "cens", !!sym(as.character(i))))
}

invisible("Se eliminan 2 casos que no tienen otra cosa que ausente")
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2<-
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2 %>% 
  dplyr::filter(`0`!="aus")

ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens<-
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% 
  dplyr::filter(`0`!="aus")

ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4<-
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4 %>% 
  dplyr::filter(`0`!="aus")  

ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4_cens<-
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4_cens %>% 
  dplyr::filter(`0`!="aus")  


ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2<-
ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2 %>% 
  dplyr::filter(`0`!="aus")

ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens<-
ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens %>% 
  dplyr::filter(`0`!="aus")

ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4<-
ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4 %>% 
  dplyr::filter(`0`!="aus")  


ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4_cens<-
ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4_cens %>% 
  dplyr::filter(`0`!="aus")  

invisible("Para mantener la base de datos anterior")
casos_prob<- c("ef1193767a2df73d6fdb1dd59d35edce262a9031d9ca5b012a11d088081b746e", 
     "bd0c2f8dcc5209831487342eda88d0b0461c98150911e36b64b4055a846a3631")
invisible("de 6,626 se reduce en 6.626 ya que ya habían sido descartado. Responden a la base 2024")

Tiempo que demora esta sección: 0.1 minutos

0. Generar un análisis de secuencias

Primero creamos un alfabeto de estados discretos (secuencias). Luego, generamos las secuencias.

#Pre-agosto
#    # state_alphabet <- c("coc", "mar", "oh", "psu", "cp",  
#    #                     "cp_psu","psy", "aus", "otro", "cens")  
#    # 
#    # # Create a vector that allows for more helpful labels if applicable 
#    # state_labels <- c("Cocaína", "Marihuana", "Alcohol", 
#    #                   "Policonsumo", "Comorbilidad", "Comorbilidad\ny policonsumo", 
#    #                   "Morbilidad\npsiquiátrica", "Ausente", "Otras causas","Censurado")

#2024-08-09: modificaron los estados del alfabeto
state_alphabet <- c("sus", "cp", "psi", "aus", "otro", "cens")  

# Create a vector that allows for more helpful labels if applicable 
state_labels <- c("Consumo\nde sustancias", "Comorbilidad", "Morbilidad\npsiquiátrica", "Ausente", "Otras causas","Censurado")

#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
invisible("Generar las trayectorias: WHY")

States_Wide.seq_quarter_t_prim_adm <- seqdef(
  ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2, #States_Wide, # Select data   
  var = match("0",names(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2)):dim(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2)[[2]],#61 para month                    # Columns containing the sequences
  alphabet = state_alphabet[-length(state_alphabet)],
  labels = state_labels[-length(state_labels)],
  start=0,  #Define el punto de inicio de la secuencia. Esto puede ser útil para visualizar mejor la secuencia.
  # left="aus", # Define el estado que se utilizará para la porción izquierda de la secuencia cuando hay datos faltantes al principio.
  #right="cens", # Define el estado que se utilizará para la porción derecha de la secuencia cuando hay datos faltantes al final.
  # gaps="aus", # Define el estado que se utilizará para representar las brechas (gaps) dentro de la secuencia.
  # missing="aus", 
  # void="aus", 
  xtstep = 4,  cpal=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                       "#FFFFFF","#808080"))#,"#000000")) 

States_Wide.seq_quarter_t_prim_adm_cens <- seqdef(
  ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, #States_Wide, # Select data   
  var = match("0",names(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2)):dim(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2)[[2]],#61 para month                    # Columns containing the sequences
  alphabet = state_alphabet,
  labels = state_labels,
  start=0,  
  right="cens",
  xtstep = 4,  cpal=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                       "#FFFFFF","#808080","#000000")) #"#000000", 

States_Wide.seq_month_t_prim_adm <- seqdef(
  ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2, #States_Wide, # Select data   
  var = match("0",names(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2)):dim(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2)[[2]],
  alphabet = state_alphabet[-length(state_alphabet)],
  labels = state_labels[-length(state_labels)],
  start=0,
xtstep = 4,  cpal=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                       "#FFFFFF","#808080"))#,"#000000")) 

States_Wide.seq_month_t_prim_adm_cens <- seqdef(
  ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens, #States_Wide, # Select data   
  var = match("0",names(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens)):dim(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens)[[2]],#2:61,#61 para month                    # Columns containing the sequences
  alphabet = state_alphabet,
  labels = state_labels,
  start=0, 
  right="cens", 
  xtstep = 4,  cpal=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                       "#FFFFFF","#808080","#000000")) #"#000000", 


#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
invisible("Generar las trayectorias: WHERE")

#state_alphabetRM <- c("noRM", "RM", "aus", "otro", "cens")  
state_alphabetRM <- c("noRM", "RM", "aus", "cens")  

# Create a vector that allows for more helpful labels if applicable 
#state_labelsRM <- c("Otra\nregión", "Región\nMetropolitana","Ausente", "Otras causas","Censurado")
state_labelsRM <- c("Otra\nregión", "Región\nMetropolitana","Ausente", "Censurado")


States_Wide.seq_quarter_t_prim_adm_RM <- seqdef(
  ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4, #States_Wide, # Select data   
  var = match("0",names(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4)):dim(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4)[[2]],#61 para month                    # Columns containing the sequences
  alphabet = state_alphabetRM[-length(state_alphabetRM)],
  labels = state_labelsRM[-length(state_labelsRM)],
  start=0,
  xtstep = 4,  cpal=c("#2A4B5F", "#F5E3A1",
                       "#FFFFFF"))#,"#808080","#000000")) 

States_Wide.seq_quarter_t_prim_adm_RM_cens <- seqdef(
  ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4_cens, #States_Wide, # Select data   
  var = match("0",names(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2)):dim(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2)[[2]],#61 para month                    # Columns containing the sequences
  alphabet = state_alphabetRM,
  labels = state_labelsRM,
  start=0,  
  right="cens",
  xtstep = 4,  cpal=c("#2A4B5F", "#F5E3A1",
                       "#FFFFFF","#000000")) #"#808080",

States_Wide.seq_month_t_prim_adm_RM <- seqdef(
  ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4, #States_Wide, # Select data   
  var = match("0",names(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4)):dim(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4)[[2]],
  alphabet = state_alphabetRM[-length(state_alphabetRM)],
  labels = state_labelsRM[-length(state_labelsRM)],
  start=0,
  xtstep = 4,  cpal=c("#2A4B5F", "#F5E3A1",
                       "#FFFFFF"))#,"#808080","#000000")) 

States_Wide.seq_month_t_prim_adm_RM_cens <- seqdef(
  ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4_cens, #States_Wide, # Select data   
  var = match("0",names(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4_cens)):dim(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4_cens)[[2]],#2:61,#61 para month                    # Columns containing the sequences
  alphabet = state_alphabetRM,
  labels = state_labelsRM,
  start=0, 
  right="cens", 
  xtstep = 4,  cpal=c("#2A4B5F", "#F5E3A1",
                       "#FFFFFF","#000000")) #"#808080",

Tiempo que demora esta sección: 0 minutos

0.a. Descriptivos

Visualizamos mediante Index plots (ordenados desde el inicio)

General

Diagnóstico- Trimestre

gc()
seqIplot(States_Wide.seq_quarter_t_prim_adm, sortv = "from.start",   # Sequence object
         with.legend = "right", # Display legend on right side of plot
         cex.legend = 0.6,  # Change size of legend
         main = "Gráfico de índice de secuencias", # Plot title
         xlab = "Trimestres desde la primera admisión") 

             used    (Mb) gc trigger    (Mb)   max used    (Mb)
Ncells   12544598   670.0   23153610  1236.6   16853252   900.1
Vcells 3315558367 25295.8 5139840243 39213.9 3359720990 25632.7

Trayectorias

Tiempo que demora esta sección: 0.4 minutos

Diagnóstico- Trimestre (c/censura)

seqIplot(States_Wide.seq_quarter_t_prim_adm_cens, sortv = "from.start",   # Sequence object
         with.legend = "right", # Display legend on right side of plot
         cex.legend = 0.6,  # Change size of legend
         main = "Gráfico de índice de secuencias (con censura)", # Plot title
         xlab = "Trimestres desde la primera admisión") 

Trayectorias

Tiempo que demora esta sección: 0.1 minutos

Diagnóstico- Mes

seqIplot(States_Wide.seq_month_t_prim_adm, sortv = "from.start",   # Sequence object
         with.legend = "right", # Display legend on right side of plot
         cex.legend = 0.6,  # Change size of legend
         main = "Gráfico de índice de secuencias", # Plot title
         xlab = "Meses desde la primera admisión") 

Trayectorias

Tiempo que demora esta sección: 0.2 minutos

Diagnóstico- Mes (c/censura)

seqIplot(States_Wide.seq_month_t_prim_adm_cens, sortv = "from.start",   # Sequence object
         with.legend = "right", # Display legend on right side of plot
         cex.legend = 0.6,  # Change size of legend
         main = "Gráfico de índice de secuencias (con censura)", # Plot title
         xlab = "Meses desde la primera admisión") 

Trayectorias

Tiempo que demora esta sección: 0.2 minutos

Región- Trimestre

seqIplot(States_Wide.seq_quarter_t_prim_adm_RM, sortv = "from.start",   # Sequence object
         with.legend = "right", # Display legend on right side of plot
         cex.legend = 0.6,  # Change size of legend
         main = "Gráfico de índice de secuencias", # Plot title
         xlab = "Trimestres desde la primera admisión") 

Trayectorias

Tiempo que demora esta sección: 0.1 minutos

Región- Trimestre (c/censura)

seqIplot(States_Wide.seq_quarter_t_prim_adm_RM_cens, sortv = "from.start",   # Sequence object
         with.legend = "right", # Display legend on right side of plot
         cex.legend = 0.6,  # Change size of legend
         main = "Gráfico de índice de secuencias (con censura)", # Plot title
         xlab = "Trimestres desde la primera admisión") 

Trayectorias

Tiempo que demora esta sección: 0.1 minutos

Región- Mes

seqIplot(States_Wide.seq_month_t_prim_adm_RM, sortv = "from.start",   # Sequence object
         with.legend = "right", # Display legend on right side of plot
         cex.legend = 0.6,  # Change size of legend
         main = "Gráfico de índice de secuencias", # Plot title
         xlab = "Meses desde la primera admisión") 

Trayectorias

Tiempo que demora esta sección: 0.1 minutos

Región- Mes (c/censura)

seqIplot(States_Wide.seq_month_t_prim_adm_RM_cens, sortv = "from.start",   # Sequence object
         with.legend = "right", # Display legend on right side of plot
         cex.legend = 0.6,  # Change size of legend
         main = "Gráfico de índice de secuencias (con censura)", # Plot title
         xlab = "Meses desde la primera admisión") 

# recorded_plot <- recordPlot() 
# png("H:/Mi unidad/PERSONAL ANDRES/UCH_salud_publica/asignaturas/un_inv_II/_figs/seqin_trim_inicio.png", height=6, width=8, res=500, units="in") 
# recorded_plot
# dev.off()

Trayectorias

Tiempo que demora esta sección: 0.2 minutos

Vemos las secuencias más frecuentes

seqtab(States_Wide.seq_quarter_t_prim_adm)->freqtab_trim
seqtab(States_Wide.seq_quarter_t_prim_adm_cens)->freqtab_trim_cens
seqtab(States_Wide.seq_month_t_prim_adm)->freqtab_mes
seqtab(States_Wide.seq_month_t_prim_adm_cens)->freqtab_mes_cens

rbind.data.frame(
cbind.data.frame(marco= "Trimestral (s/censura)", data.table::as.data.table(attr(freqtab_trim,"freq"), keep.rownames = "Secuencias (estado/frecuencia)")),
cbind.data.frame(marco= "Trimestral (c/censura)", data.table::as.data.table(attr(freqtab_trim_cens,"freq"), keep.rownames = "Secuencias (estado/frecuencia)")),
cbind.data.frame(marco= "Mensual (s/censura)", data.table::as.data.table(attr(freqtab_mes,"freq"), keep.rownames = "Secuencias (estado/frecuencia)")),
cbind.data.frame(marco= "Mensual (c/censura)", data.table::as.data.table(attr(freqtab_mes_cens,"freq"), keep.rownames = "Secuencias (estado/frecuencia)"))
) %>% 
  dplyr::mutate(Percent= scales::percent(Percent/100, accuracy=0.1)) %>% 
  {
  #copiar_nombres2()
    write.table(., file = paste0(getwd(),"secuencias_mas_frecuentes_25.csv"), dec=",", sep="\t")
    knitr::kable(., size=10, format="html", caption="Secuencias más frecuentes") %>% 
    kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12) %>% 
    kableExtra::scroll_box(width = "100%", height = "375px")  
  }

Secuencias más frecuentes

marco	Secuencias (estado/frecuencia)	Freq	Percent
Trimestral (s/censura)	psi/1-aus/19	3327	50.2%
Trimestral (s/censura)	sus/1-aus/19	485	7.3%
Trimestral (s/censura)	psi/2-aus/18	142	2.1%
Trimestral (s/censura)	cp/1-aus/19	119	1.8%
Trimestral (s/censura)	psi/1-otro/1-aus/18	91	1.4%
Trimestral (s/censura)	psi/1-aus/2-otro/1-aus/16	80	1.2%
Trimestral (s/censura)	psi/1-aus/3-otro/1-aus/15	78	1.2%
Trimestral (s/censura)	psi/1-aus/1-otro/1-aus/17	72	1.1%
Trimestral (s/censura)	psi/1-aus/6-otro/1-aus/12	64	1.0%
Trimestral (s/censura)	psi/1-aus/5-otro/1-aus/13	63	1.0%
Trimestral (c/censura)	psi/1-aus/18-cens/1	892	13.5%
Trimestral (c/censura)	psi/1-aus/16-cens/3	890	13.4%
Trimestral (c/censura)	psi/1-aus/17-cens/2	832	12.6%
Trimestral (c/censura)	psi/1-aus/19	671	10.1%
Trimestral (c/censura)	sus/1-aus/19	144	2.2%
Trimestral (c/censura)	sus/1-aus/18-cens/1	113	1.7%
Trimestral (c/censura)	sus/1-aus/17-cens/2	112	1.7%
Trimestral (c/censura)	sus/1-aus/16-cens/3	102	1.5%
Trimestral (c/censura)	psi/2-aus/17-cens/1	41	0.6%
Trimestral (c/censura)	psi/2-aus/16-cens/2	39	0.6%
Mensual (s/censura)	psi/1-aus/59	2786	42.0%
Mensual (s/censura)	sus/1-aus/59	443	6.7%
Mensual (s/censura)	psi/2-aus/58	369	5.6%
Mensual (s/censura)	psi/3-aus/57	84	1.3%
Mensual (s/censura)	cp/1-aus/59	81	1.2%
Mensual (s/censura)	psi/1-otro/1-aus/58	35	0.5%
Mensual (s/censura)	psi/1-aus/20-otro/1-aus/38	28	0.4%
Mensual (s/censura)	sus/2-aus/58	28	0.4%
Mensual (s/censura)	psi/1-aus/10-otro/1-aus/48	27	0.4%
Mensual (s/censura)	psi/1-aus/13-otro/1-aus/45	24	0.4%
Mensual (c/censura)	psi/1-aus/55-cens/4	269	4.1%
Mensual (c/censura)	psi/1-aus/50-cens/9	267	4.0%
Mensual (c/censura)	psi/1-aus/49-cens/10	258	3.9%
Mensual (c/censura)	psi/1-aus/52-cens/7	256	3.9%
Mensual (c/censura)	psi/1-aus/54-cens/5	250	3.8%
Mensual (c/censura)	psi/1-aus/48-cens/11	244	3.7%
Mensual (c/censura)	psi/1-aus/56-cens/3	229	3.5%
Mensual (c/censura)	psi/1-aus/51-cens/8	219	3.3%
Mensual (c/censura)	psi/1-aus/53-cens/6	219	3.3%
Mensual (c/censura)	psi/1-aus/57-cens/2	202	3.0%

Tiempo que demora esta sección: 0.1 minutos

A partir de la tabla anterior, se confirma que más del 50% sólo tienen un evento hospitalario, liderando el por causas psiquiátricas (52%) seguido muy de lejos por un sólo ingreso por consumo de sustancias (8%) y comorbilidad (2%). Luego, un 2% tiene más de un evento psiquiátrico que habría durado más de un trimestre, presumiblemente, debido a su continuidad. Para la base con datos mensuales, un 44% corresponde a un mes en ingreso por causas psiquiátricas, un 7% por causas por consumo de sustancias y un 1% por comorbilidad. También se constata eventos compuestos de 2 meses en consulta psiquiátrica (6%) y hasta 3 (1%).

seqtab(States_Wide.seq_quarter_t_prim_adm_RM)->freqtab_trim_reg
seqtab(States_Wide.seq_quarter_t_prim_adm_RM_cens)->freqtab_trim_cens_reg
seqtab(States_Wide.seq_month_t_prim_adm_RM)->freqtab_mes_reg
seqtab(States_Wide.seq_month_t_prim_adm_RM_cens)->freqtab_mes_cens_reg

rbind.data.frame(
cbind.data.frame(marco= "Trimestral (s/censura)", data.table::as.data.table(attr(freqtab_trim_reg,"freq"), keep.rownames = "Secuencias (estado/frecuencia)")),
cbind.data.frame(marco= "Trimestral (c/censura)", data.table::as.data.table(attr(freqtab_trim_cens_reg,"freq"), keep.rownames = "Secuencias (estado/frecuencia)")),
cbind.data.frame(marco= "Mensual (s/censura)", data.table::as.data.table(attr(freqtab_mes_reg,"freq"), keep.rownames = "Secuencias (estado/frecuencia)")),
cbind.data.frame(marco= "Mensual (c/censura)", data.table::as.data.table(attr(freqtab_mes_cens_reg,"freq"), keep.rownames = "Secuencias (estado/frecuencia)"))
) %>% 
  dplyr::mutate(Percent= scales::percent(Percent/100, accuracy=0.1)) %>% 
  {
  #copiar_nombres2()
    write.table(., file = paste0(getwd(),"secuencias_mas_frecuentes_reg_25.csv"), dec=",", sep="\t")
    knitr::kable(., size=10, format="html", caption="Secuencias más frecuentes (region)") %>% 
    kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12) %>% 
    kableExtra::scroll_box(width = "100%", height = "375px")  
  }

Secuencias más frecuentes (region)

marco	Secuencias (estado/frecuencia)	Freq	Percent
Trimestral (s/censura)	noRM/1-aus/19	2146	32.4%
Trimestral (s/censura)	RM/1-aus/19	1785	26.9%
Trimestral (s/censura)	noRM/2-aus/18	144	2.2%
Trimestral (s/censura)	RM/2-aus/18	122	1.8%
Trimestral (s/censura)	noRM/1-aus/2-noRM/1-aus/16	80	1.2%
Trimestral (s/censura)	noRM/1-aus/1-noRM/1-aus/17	76	1.1%
Trimestral (s/censura)	noRM/1-aus/5-noRM/1-aus/13	67	1.0%
Trimestral (s/censura)	RM/1-aus/3-RM/1-aus/15	65	1.0%
Trimestral (s/censura)	RM/1-aus/2-RM/1-aus/16	63	1.0%
Trimestral (s/censura)	noRM/1-aus/3-noRM/1-aus/15	62	0.9%
Trimestral (c/censura)	noRM/1-aus/18-cens/1	561	8.5%
Trimestral (c/censura)	noRM/1-aus/17-cens/2	538	8.1%
Trimestral (c/censura)	noRM/1-aus/16-cens/3	535	8.1%
Trimestral (c/censura)	RM/1-aus/16-cens/3	484	7.3%
Trimestral (c/censura)	noRM/1-aus/19	476	7.2%
Trimestral (c/censura)	RM/1-aus/18-cens/1	467	7.0%
Trimestral (c/censura)	RM/1-aus/17-cens/2	436	6.6%
Trimestral (c/censura)	RM/1-aus/19	374	5.6%
Trimestral (c/censura)	noRM/2-aus/17-cens/1	42	0.6%
Trimestral (c/censura)	noRM/2-aus/15-cens/3	39	0.6%
Mensual (s/censura)	noRM/1-aus/59	1847	27.9%
Mensual (s/censura)	RM/1-aus/59	1463	22.1%
Mensual (s/censura)	RM/2-aus/58	252	3.8%
Mensual (s/censura)	noRM/2-aus/58	204	3.1%
Mensual (s/censura)	noRM/3-aus/57	56	0.8%
Mensual (s/censura)	RM/3-aus/57	52	0.8%
Mensual (s/censura)	noRM/1-aus/1-noRM/1-aus/57	26	0.4%
Mensual (s/censura)	noRM/1-aus/3-noRM/1-aus/55	25	0.4%
Mensual (s/censura)	noRM/1-aus/10-noRM/1-aus/48	22	0.3%
Mensual (s/censura)	noRM/1-aus/19-noRM/1-aus/39	21	0.3%
Mensual (c/censura)	noRM/1-aus/55-cens/4	184	2.8%
Mensual (c/censura)	noRM/1-aus/50-cens/9	163	2.5%
Mensual (c/censura)	noRM/1-aus/52-cens/7	163	2.5%
Mensual (c/censura)	noRM/1-aus/48-cens/11	160	2.4%
Mensual (c/censura)	RM/1-aus/49-cens/10	158	2.4%
Mensual (c/censura)	noRM/1-aus/54-cens/5	157	2.4%
Mensual (c/censura)	noRM/1-aus/51-cens/8	151	2.3%
Mensual (c/censura)	noRM/1-aus/49-cens/10	149	2.2%
Mensual (c/censura)	noRM/1-aus/53-cens/6	149	2.2%
Mensual (c/censura)	RM/1-aus/50-cens/9	145	2.2%

Tiempo que demora esta sección: 0 minutos

Para las secuencias regionales, se observa que una mayor parte de los ingresos corresponde a personas que no tienen su primer y único ingreso en la región metropolitana (34%), seguido por quienes sí lo tienen (28%). Posteriormente, se encuentran los que tienen un evento continuo presumiblemente fuera de la región metropolitana (2%) y en la región metropolitana (2%).

Luego, vimos un tiempo promedio en cada estado.

Entropía

La entropía transversal es una métrica de diversidad de estados observados en cada posición. Un valor de 0 significa que todos las observaciones están en un mismo estado y su valor es máximo cuando hay una misma proporción de casos que están en el mismo estado.

Diagnóstico-Trimestre

plot(seqstatd(States_Wide.seq_quarter_t_prim_adm), type="Ht", #main="Age-specific Shannon's Entropy", 
     xlab= "Trimestres", xtlab=1:21)

Entropía de Shannon por tiempo de seguimiento

Tiempo que demora esta sección: 0 minutos

Diagnóstico-Trimestre (c/censura)

plot(seqstatd(States_Wide.seq_quarter_t_prim_adm_cens), type="Ht", #main="Age-specific Shannon's Entropy", 
     xlab= "Trimestres", xtlab=1:21)

Entropía de Shannon por tiempo de seguimiento

Tiempo que demora esta sección: 0 minutos

Diagnóstico-Mes

plot(seqstatd(States_Wide.seq_month_t_prim_adm), type="Ht", #main="Age-specific Shannon's Entropy", 
     xlab= "Meses", xtlab=1:61)

Entropía de Shannon por tiempo de seguimiento

Tiempo que demora esta sección: 0 minutos

Diagnóstico-Mes (c/censura)

plot(seqstatd(States_Wide.seq_month_t_prim_adm_cens), type="Ht", #main="Age-specific Shannon's Entropy", 
     xlab= "Meses", xtlab=1:61)

Entropía de Shannon por tiempo de seguimiento

Tiempo que demora esta sección: 0 minutos

Región-Trimestre

plot(seqstatd(States_Wide.seq_quarter_t_prim_adm_RM), type="Ht", #main="Age-specific Shannon's Entropy", 
     xlab= "Trimestre", xtlab=1:21)

Entropía de Shannon por tiempo de seguimiento

Tiempo que demora esta sección: 0 minutos

Región-Trimestre (c/censura)

plot(seqstatd(States_Wide.seq_quarter_t_prim_adm_RM_cens), type="Ht", #main="Age-specific Shannon's Entropy", 
     xlab= "Trimestre", xtlab=1:21)

Entropía de Shannon por tiempo de seguimiento

Tiempo que demora esta sección: 0 minutos

Región-Mes

plot(seqstatd(States_Wide.seq_month_t_prim_adm_RM), type="Ht", #main="Age-specific Shannon's Entropy", 
     xlab= "Meses", xtlab=1:61)

Entropía de Shannon por tiempo de seguimiento

Tiempo que demora esta sección: 0 minutos

Región-Mes (c/censura)

plot(seqstatd(States_Wide.seq_month_t_prim_adm_RM_cens), type="Ht", #main="Age-specific Shannon's Entropy", 
     xlab= "Meses", xtlab=1:61)

Entropía de Shannon por tiempo de seguimiento

Tiempo que demora esta sección: 0 minutos

En general todos parecen estar en el estado ausente, salvo en los modelos que incorporan censura al final del estudio, en donde aparecen como censurados.

Tiempo promedio en cada estado

Promedio-Diagnóstico-Trimestre-Sexo

invisible("2024-09-02, sacar cosas")
seq_mean_t(States_Wide.seq_quarter_t_prim_adm, 
           subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, glosa_sexo)) %>%
  data.table::as.data.table(keep.rowname=T) %>% 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  coord_flip()+
  labs(title = "Tiempo promedio en cada estado por sexo (Trimestral, s/censura)",
       x = NULL,
       y = NULL) +
  theme(#axis.text.x = element_blank(),
        #axis.text.y = element_blank(),
        panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1") +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())

Tiempo promedio en cada estado por distintas variables (trimestral)

Tiempo que demora esta sección: 0 minutos

Promedio-RM-Trimestre-Sexo

seq_mean_t(States_Wide.seq_quarter_t_prim_adm_RM, 
            subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4, !run %in% casos_prob, glosa_sexo)) %>%
  data.table::as.data.table(keep.rowname=T) %>% 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  coord_flip()+
  labs(title = "Tiempo promedio en cada estado por sexo (Trimestral, s/censura)",
       x = NULL,
       y = NULL) +
  theme(#axis.text.x = element_blank(),
        #axis.text.y = element_blank(),
        panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1") +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())

Tiempo promedio en cada estado por distintas variables (trimestral)

Tiempo que demora esta sección: 0 minutos

Promedio-Diagnóstico-Trimestre-Sexo (c/censura)

seq_mean_t(States_Wide.seq_quarter_t_prim_adm_cens, 
           subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, glosa_sexo)) %>% 
  data.table::as.data.table(keep.rowname=T) %>% 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  coord_flip()+
  labs(title = "Tiempo promedio en cada estado por sexo (Trimestral, c/censura)",
       x = NULL,
       y = NULL) +
  theme(#axis.text.x = element_blank(),
    #axis.text.y = element_blank(),
    panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1") +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())  

Tiempo promedio en cada estado por distintas variables (trimestral)

Tiempo que demora esta sección: 0 minutos

Promedio-Diagnóstico-Trimestre-PPOO

seq_mean_t(States_Wide.seq_quarter_t_prim_adm, 
           subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, factor_inclusivo_real_hist_mas_autperc))%>% 
  data.table::as.data.table(keep.rowname=T) %>% 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  labs(title = "Tiempo promedio en cada estado por estatus PPOO (Trimestral s/censura)",
       x = NULL,
       y = NULL) +
  coord_flip()+
  theme(#axis.text.x = element_blank(),
    #axis.text.y = element_blank(),
    panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1", labels=c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas")) +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())

Tiempo promedio en cada estado por distintas variables (trimestral)

Tiempo que demora esta sección: 0 minutos

Promedio-RM-Trimestre-PPOO

seq_mean_t(States_Wide.seq_quarter_t_prim_adm_RM, 
           subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4, !run %in% casos_prob, factor_inclusivo_real_hist_mas_autperc)) %>% 
  data.table::as.data.table(keep.rowname=T) %>% 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  labs(title = "Tiempo promedio en cada estado por estatus PPOO (Trimestral s/censura)",
       x = NULL,
       y = NULL) +
  coord_flip()+
  theme(#axis.text.x = element_blank(),
    #axis.text.y = element_blank(),
    panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1", labels=c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas")) +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())

Tiempo promedio en cada estado por distintas variables (trimestral)

Tiempo que demora esta sección: 0 minutos

Promedio-Diagnóstico-Trimestre-PPOO (c/censura)

seq_mean_t(States_Wide.seq_quarter_t_prim_adm_cens, 
           subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide_cens, !run %in% casos_prob, factor_inclusivo_real_hist_mas_autperc)) %>% 
  data.table::as.data.table(keep.rowname=T) %>% 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  labs(title = "Tiempo promedio en cada estado por estatus PPOO (Trimestral c/censura)",
       x = NULL,
       y = NULL) +
  coord_flip()+
  theme(#axis.text.x = element_blank(),
    #axis.text.y = element_blank(),
    panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1", labels=c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas")) +
    geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())

Tiempo promedio en cada estado por distintas variables (trimestral)

Tiempo que demora esta sección: 0 minutos

Ahora por mes

Promedio-Diagnóstico-Mes-Sexo

seq_mean_t(States_Wide.seq_month_t_prim_adm, 
           subset(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, glosa_sexo)) %>%
  data.table::as.data.table(keep.rowname=T) %>% 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  coord_flip()+
  labs(title = "Tiempo promedio en cada estado por sexo (Mensual, s/censura)",
       x = NULL,
       y = NULL) +
  theme(#axis.text.x = element_blank(),
        #axis.text.y = element_blank(),
        panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1") +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())

Tiempo promedio en cada estado por distintas variables (mensual)

Tiempo que demora esta sección: 0 minutos

Promedio-RM-Mes-Sexo

seq_mean_t(States_Wide.seq_month_t_prim_adm_RM, 
           subset(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, glosa_sexo)) %>%
  data.table::as.data.table(keep.rowname=T) %>% 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  coord_flip()+
  labs(title = "Tiempo promedio en cada estado por sexo (Mensual, s/censura)",
       x = NULL,
       y = NULL) +
  theme(#axis.text.x = element_blank(),
        #axis.text.y = element_blank(),
        panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1") +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())

Tiempo promedio en cada estado por distintas variables (mensual)

Tiempo que demora esta sección: 0 minutos

Promedio-Diagnóstico-Mes-Sexo (c/censura)

seq_mean_t(States_Wide.seq_month_t_prim_adm_cens, 
           subset(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide_cens, !run %in% casos_prob, glosa_sexo)) %>% 
  data.table::as.data.table(keep.rowname=T) %>% 
  data.table::as.data.table(keep.rowname=T) %>% 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  coord_flip()+
  labs(title = "Tiempo promedio en cada estado por sexo (Mensual, c/censura)",
       x = NULL,
       y = NULL) +
  theme(#axis.text.x = element_blank(),
    #axis.text.y = element_blank(),
    panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1") +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())  

Tiempo promedio en cada estado por distintas variables (mensual)

Tiempo que demora esta sección: 0 minutos

Promedio-Diagnóstico-Mes-PPOO

seq_mean_t(States_Wide.seq_month_t_prim_adm, 
           subset(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, factor_inclusivo_real_hist_mas_autperc)) %>% 
  data.table::as.data.table(keep.rowname=T) %>% 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  labs(title = "Tiempo promedio en cada estado por estatus PPOO (Mensual s/censura)",
       x = NULL,
       y = NULL) +
  coord_flip()+
  theme(#axis.text.x = element_blank(),
    #axis.text.y = element_blank(),
    panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1", labels=c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas")) +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())

Tiempo promedio en cada estado por distintas variables (mensual)

Tiempo que demora esta sección: 0 minutos

Promedio-RM-Mes-PPOO

seq_mean_t(States_Wide.seq_month_t_prim_adm_RM, 
           subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4, !run %in% casos_prob, factor_inclusivo_real_hist_mas_autperc)) %>% 
  data.table::as.data.table(keep.rowname=T) %>% 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  labs(title = "Tiempo promedio en cada estado por estatus PPOO (Mensual s/censura)",
       x = NULL,
       y = NULL) +
  coord_flip()+
  theme(#axis.text.x = element_blank(),
    #axis.text.y = element_blank(),
    panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1", labels=c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas")) +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())

Tiempo promedio en cada estado por distintas variables (mensual)

Tiempo que demora esta sección: 0 minutos

Promedio-Diagnóstico-Mes-PPOO (c/censura)

seq_mean_t(States_Wide.seq_month_t_prim_adm_cens, 
           subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide_cens, !run %in% casos_prob, factor_inclusivo_real_hist_mas_autperc)) %>% 
  data.table::as.data.table(keep.rowname=T) %>% 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  labs(title = "Tiempo promedio en cada estado por estatus PPOO (Mensual c/censura)",
       x = NULL,
       y = NULL) +
  coord_flip()+
  theme(#axis.text.x = element_blank(),
    #axis.text.y = element_blank(),
    panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1", labels=c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas")) +
    geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())

Tiempo promedio en cada estado por distintas variables (mensual)

Tiempo que demora esta sección: 0 minutos

No se aprecian diferencias sustanciales por categoría. Tal vez, las mujeres se encuentran más tiempo en ingresos psiquiátricos y por otras causas, pero es una diferencia muy leve. Quienes no están en la Región Metropolitana tienen más tiempo en promedio en ingreso hospitalario para el caso de quienes tienen reconocimiento CONADI y se autoidentifican además de los que sólo tienen autoidentificación vs. las personas en la región metropolitana.

0.b. Tasas de transición

La probabilidad de cambiar en un posición de un estado a otro. Por defecto, las probabilidades se asumieron independientes de la posición, esto es, el mismo sin importar el punto de tiempo.

Trimestre

Sin censura-Sexo

trim_tasa_sexo_cnt<-  
seqcount_t(States_Wide.seq_quarter_t_prim_adm, 
           group=subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, glosa_sexo)) %>% 
  dplyr::filter(count>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

trim_tasa_sexo_rate<-  
seqtrate_t(States_Wide.seq_quarter_t_prim_adm, 
           group=subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, glosa_sexo)) %>% 
  dplyr::filter(rate>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  

trim_tasa_sexo_rate %>%   
dplyr::left_join(trim_tasa_sexo_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) %>% 
  dplyr::rename("recuento"="count") %>% 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Trimestre (s/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")

Tasas de transición (trimestral)

Tiempo que demora esta sección: 0 minutos

Sin censura-Sexo-RM

trim_tasa_sexo_cnt_rm<-  
seqcount_t(States_Wide.seq_quarter_t_prim_adm_RM, 
           group= subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, glosa_sexo)) %>% 
  dplyr::filter(count>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

trim_tasa_sexo_rate_rm<-  
seqtrate_t(States_Wide.seq_quarter_t_prim_adm_RM, 
           group= subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, glosa_sexo)) %>% 
  dplyr::filter(rate>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  

trim_tasa_sexo_rate_rm %>%   
dplyr::left_join(trim_tasa_sexo_cnt_rm, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) %>% 
  dplyr::rename("recuento"="count") %>% 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Trimestre (s/censura)- RM",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")

Tasas de transición (trimestral)

Tiempo que demora esta sección: 0 minutos

Con censura-Sexo

trim_tasa_sexo_cnt_cens<-  
seqcount_t(States_Wide.seq_quarter_t_prim_adm_cens, 
           group= subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide_cens, !run %in% casos_prob, glosa_sexo)) %>% 
  dplyr::filter(count>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

trim_tasa_sexo_rate_cens<-  
seqtrate_t(States_Wide.seq_quarter_t_prim_adm_cens, 
           group= subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide_cens, !run %in% casos_prob, glosa_sexo)) %>% 
  dplyr::filter(rate>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  



trim_tasa_sexo_rate_cens %>%   
dplyr::left_join(trim_tasa_sexo_cnt_cens, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) %>% 
  dplyr::rename("recuento"="count") %>% 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Trimestre (c/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")

Tasas de transición (trimestral)

Tiempo que demora esta sección: 0 minutos

Sin censura-PPOO

trim_tasa_ppoo_cnt<-  
seqcount_t(States_Wide.seq_quarter_t_prim_adm, 
           group=factor(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) %>% 
  dplyr::filter(count>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

trim_tasa_ppoo_rate<-  
seqtrate_t(States_Wide.seq_quarter_t_prim_adm, 
           group=factor(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) %>% 
  dplyr::filter(rate>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  



trim_tasa_ppoo_rate %>%   
dplyr::left_join(trim_tasa_ppoo_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) %>% 
  dplyr::rename("recuento"="count") %>% 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Trimestre (s/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")

Tasas de transición (trimestral)

Tiempo que demora esta sección: 0 minutos

Sin censura-PPOO-RM

trim_tasa_ppoo_cnt_rm<-  
seqcount_t(States_Wide.seq_quarter_t_prim_adm_RM, 
           group=factor(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) %>% 
  dplyr::filter(count>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

trim_tasa_ppoo_rate_rm<-  
seqtrate_t(States_Wide.seq_quarter_t_prim_adm_RM, 
           group=factor(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) %>% 
  dplyr::filter(rate>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  



trim_tasa_ppoo_rate_rm %>%   
dplyr::left_join(trim_tasa_ppoo_cnt_rm, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) %>% 
  dplyr::rename("recuento"="count") %>% 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Trimestre (s/censura) (RM)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")

Tasas de transición (trimestral)

Tiempo que demora esta sección: 0 minutos

Con censura-PPOO

trim_tasa_ppoo_cnt_cens<-  
seqcount_t(States_Wide.seq_quarter_t_prim_adm_cens, 
           group=factor(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) %>% 
  dplyr::filter(count>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

trim_tasa_ppoo_rate_cens<-  
seqtrate_t(States_Wide.seq_quarter_t_prim_adm_cens, 
           group=factor(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) %>% 
  dplyr::filter(rate>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  



trim_tasa_ppoo_rate_cens %>%   
dplyr::left_join(trim_tasa_ppoo_cnt_cens, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) %>% 
  dplyr::rename("recuento"="count") %>% 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Trimestre (c/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")

Tasas de transición (trimestral)

Tiempo que demora esta sección: 0 minutos

Para ver los números detrás de las transiciones, calcular exp(x-1).

• De los ingresos por otras causas, más hombres transitan a un nuevo ingreso por otras causas (16%, n=94 vs. 12%, n=148), más hombres se mantienen transitando desde comorbilidad a ingresos presentando comorbilidad nuevamente (14%, n=34 vs. 11%, n=12), pero más mujeres que ingresaron por sustancias reingresan al sistema de salud por algún motivo (16%, n=42 vs. 10%, n=54).
• Aunque son pocos casos, personas con autoidentificación y reconocimiento (~30) que ingresaron por comorbilidad registran más transiciones a comorbilidad (14%, n=4) o ingreso con diagnóstico psiquiátrico (14%, n=4) vs. el resto.
• Asimismo, personas con autoidentificación y reconocimiento y autoidentificación sin reconocimiento que ingresan por consumo de sustancias tienen más ingresos relativos (8%, n=7; 10% n=10) que sin autoidentificación ni reconocimiento (5% n=33).

trim_tasa_sexo_rate %>% 
    dplyr::left_join(trim_tasa_sexo_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to"))%>% 
    dplyr::rename("recuento"="count") %>% 
    dplyr::filter(from=="sus") %>% 
    dplyr::mutate(gr=ifelse(to=="aus",1,0)) %>% 
    dplyr::group_by(glosa_sexo,gr) %>% 
        summarise(rate=sum(rate),recuento=sum(recuento))

trim_tasa_ppoo_rate %>%   
  dplyr::left_join(trim_tasa_ppoo_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to"))%>%
  dplyr::rename("recuento"="count") %>% 
  dplyr::filter(from=="cp")

Tiempo que demora esta sección: 0 minutos

Mensual

Sin censura-Sexo

mes_tasa_sexo_cnt<-  
seqcount_t(States_Wide.seq_month_t_prim_adm, 
           group=ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2$glosa_sexo) %>% 
  dplyr::filter(count>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

mes_tasa_sexo_rate<-  
seqtrate_t(States_Wide.seq_month_t_prim_adm, 
           group=ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2$glosa_sexo) %>% 
  dplyr::filter(rate>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  

mes_tasa_sexo_rate %>%   
dplyr::left_join(mes_tasa_sexo_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) %>% 
  dplyr::rename("recuento"="count") %>% 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Mensual (s/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")

Tasas de transición (mensual)

Tiempo que demora esta sección: 0 minutos

Sin censura-Sexo-RM

mes_tasa_sexo_cnt_rm<-  
seqcount_t(States_Wide.seq_month_t_prim_adm_RM, 
           group=ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2$glosa_sexo) %>% 
  dplyr::filter(count>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

mes_tasa_sexo_rate_rm<-  
seqtrate_t(States_Wide.seq_month_t_prim_adm_RM, 
           group=ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2$glosa_sexo) %>% 
  dplyr::filter(rate>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  

mes_tasa_sexo_rate_rm %>%   
dplyr::left_join(mes_tasa_sexo_cnt_rm, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) %>% 
  dplyr::rename("recuento"="count") %>% 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Mensual (s/censura) (RM)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")

Tasas de transición (mensual)

Tiempo que demora esta sección: 0 minutos

Con censura-Sexo

mes_tasa_sexo_cnt_cens<-  
seqcount_t(States_Wide.seq_month_t_prim_adm_cens, 
           group=ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2$glosa_sexo) %>% 
  dplyr::filter(count>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

mes_tasa_sexo_rate_cens<-  
seqtrate_t(States_Wide.seq_month_t_prim_adm_cens,
           group=ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2$glosa_sexo) %>% 
  dplyr::filter(rate>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  



mes_tasa_sexo_rate_cens %>%   
dplyr::left_join(mes_tasa_sexo_cnt_cens, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) %>% 
  dplyr::rename("recuento"="count") %>% 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Mensual (c/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")

Tasas de transición (mensual)

Tiempo que demora esta sección: 0 minutos

Sin censura-PPOO

mes_tasa_ppoo_cnt<-  
seqcount_t(States_Wide.seq_month_t_prim_adm, 
           group=factor(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) %>% 
  dplyr::filter(count>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

mes_tasa_ppoo_rate<-  
seqtrate_t(States_Wide.seq_month_t_prim_adm, 
           group=factor(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) %>% 
  dplyr::filter(rate>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  



mes_tasa_ppoo_rate %>%   
dplyr::left_join(mes_tasa_ppoo_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) %>% 
  dplyr::rename("recuento"="count") %>% 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Mensual (s/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")

Tasas de transición (mensual)

Tiempo que demora esta sección: 0 minutos

Sin censura-PPOO-RM

mes_tasa_ppoo_cnt_rm<-  
seqcount_t(States_Wide.seq_month_t_prim_adm_RM, 
           group=factor(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) %>% 
  dplyr::filter(count>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

mes_tasa_ppoo_rate_rm<-  
seqtrate_t(States_Wide.seq_month_t_prim_adm_RM, 
           group=factor(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) %>% 
  dplyr::filter(rate>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  



mes_tasa_ppoo_rate_rm %>%   
dplyr::left_join(mes_tasa_ppoo_cnt_rm, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) %>% 
  dplyr::rename("recuento"="count") %>% 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Mensual (s/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")

Tasas de transición (mensual)

Tiempo que demora esta sección: 0 minutos

Con censura-PPOO

mes_tasa_ppoo_cnt_cens<-  
seqcount_t(States_Wide.seq_month_t_prim_adm_cens, 
           group=factor(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) %>% 
  dplyr::filter(count>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

mes_tasa_ppoo_rate_cens<-  
seqtrate_t(States_Wide.seq_month_t_prim_adm_cens, 
           group=factor(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) %>% 
  dplyr::filter(rate>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  



mes_tasa_ppoo_rate_cens %>%   
dplyr::left_join(mes_tasa_ppoo_cnt_cens, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) %>% 
  dplyr::rename("recuento"="count") %>% 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Mensual (c/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")

Tasas de transición (mensual)

Tiempo que demora esta sección: 0 minutos

Para ver los números detrás de las transiciones, calcular exp(x-1).

• Más mujeres que ingresaron por sustancias reingresan al sistema de salud por dicho motivo (23%, n=73 vs. 12%, n=74).
• Más hombres que ingresan con diagnósticos psiquiátricos transitan a un ingreso con un diagnóstico del mismo tipo (35%, n=1517 vs. 26%, n=1404). Asimismo, más hombres que ingresan por otros motivos también registran un ingreso posterior por otros motivos (25%, n=188 vs. 19%, n=303). Por último, hombres que ingresan por comorbilidad experimentan una transición a comorbilidad con mayor frecuencia (43%, n=148 vs. 29%, n=38).
• Entre quienes ingresan por sustancias, quienes se autoidentifican y son reconocidos como pertenecientes a PPOO presentan menos transiciones al mismo estado (13%, n=13) vs. quienes se autoidentifican pero no son reconocidos (18% n=21) o que no se autoidentifican ni son reconocidos (15% n=113).
• Quienes se autoidentifican pero no poseen reconocimiento de la CONADI y fueron ingresados con diagnóstico de comorbilidad, registran menos transiciones a un ingreso con comorbilidad (24%, n=8) que el resto (40%, n_ambas=17, n_ninguna= 161)
• Mujeres tienen menos transiciones (~25% vs. ~33%) que hombres cuando vemos las transiciones de región.

En resumen: - Se hace difícil distinguir entre PPOO por grados hasta el momento. Dejarlo para una reflexión posterior, para el análisis una vez teniendo los conglomerados.

trim_tasa_sexo_rate %>% 
    dplyr::left_join(trim_tasa_sexo_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to"))%>% 
    dplyr::rename("recuento"="count") %>% 
    dplyr::filter(from=="sus") %>% 
    dplyr::mutate(gr=ifelse(to=="aus",1,0)) %>% 
    dplyr::group_by(glosa_sexo,gr) %>% 
        summarise(rate=sum(rate),recuento=sum(recuento))

trim_tasa_ppoo_rate %>%   
  dplyr::left_join(trim_tasa_ppoo_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to"))%>%
  dplyr::rename("recuento"="count") %>% 
  dplyr::filter(from=="cp")
#mes_tasa_ppoo_rate_cens  
#mes_tasa_sexo_cnt_rm
#
#
mes_tasa_sexo_rate %>%   
dplyr::left_join(mes_tasa_sexo_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) %>% 
  dplyr::rename("recuento"="count") %>% 
  dplyr::filter(from=="sus")

Tiempo que demora esta sección: 0 minutos

1. Generamos matriz de sustituciones

Generamos mediante los algoritmos de Optimal Matching (OM) y Longest Common Subsequence (LCS). Se calcularon los costos de substitución entre secuencias de estados en un análisis de secuencias. El método utilizado es el TRATE, que calcula los costos en base a las tasas de transición observadas. Por fines computacionales, se asumirán que los costos no varían con el tiempo. Es decir, se asume que el costo de transición entre dos estados es constante a lo largo del período de estudio.

costmatrix_quarter <- seqsubm(States_Wide.seq_quarter_t_prim_adm,  # Sequence object
                      method = "TRATE",  # Method to determine costs
                      time.varying = FALSE) # Does not allow the cost to vary over time)
costmatrix_quarter_rm <- seqsubm(States_Wide.seq_quarter_t_prim_adm_RM,  # Sequence object
                      method = "TRATE",  # Method to determine costs
                      time.varying = FALSE) # Does not allow the cost to vary over time)
costmatrix_quarter_cens <- seqsubm(States_Wide.seq_quarter_t_prim_adm_cens,  # Sequence object
                      method = "TRATE",  # Method to determine costs
                      time.varying = FALSE) # Does not allow the cost to vary over time)
costmatrix_month <- seqsubm(States_Wide.seq_month_t_prim_adm,  # Sequence object
                      method = "TRATE",  # Method to determine costs
                      time.varying = FALSE) # Does not allow the cost to vary over time)
costmatrix_month_rm <- seqsubm(States_Wide.seq_quarter_t_prim_adm_RM,  # Sequence object
                      method = "TRATE",  # Method to determine costs
                      time.varying = FALSE) # Does not allow the cost to vary over time)
costmatrix_month_cens <- seqsubm(States_Wide.seq_month_t_prim_adm_cens,  # Sequence object
                      method = "TRATE",  # Method to determine costs
                      time.varying = FALSE) # Does not allow the cost to vary over time)

Tiempo que demora esta sección: 0 minutos

2. Análisis de cluster

Generamos distintas soluciones con distintas cantidades de conglomerados, desde 2 a 15, utilizando los algoritmos de distancia OM y LCS (1), además de replicarlo tanto para secuencias trimestrales y mensuales (2) y con y sin censura (3).

Primero calculamos una matriz de distancias utilizando el método de optimización de correspondencias (Optimal Matching, OM) y utilizando el método de la secuencia común más larga (Longest common subsequence, LCS). El primero tiene la ventaja de comparar secuencias de distinta duración, siendo bastante flexible, aunque puede implicar la distrorsión de los tiempos involucrados. Por otra parte, el segundo, al buscar la secuencia común más larga (independiente de estados intermedios), tiene la ventaja de no ser necesario definir costos de inserción o eliminación, no tener que ajustar muchos parámetros sujetos a decisiones arbitrarias, lo que hace más fácil de interpretar ya que se centra en las partes de secuencias que coinciden.Sin embargo, esta simplificación pierde diferencias o similitudes más específicas, y no permite ajustar esos costos de las diferencias.

# ---- ** OPTIMAL MATCHING ----
dist_quarter_om <- seqdist(States_Wide.seq_quarter_t_prim_adm,
                   method = "OM",
                   indel= 1.0, #Ignored with non OM metrics.
                   sm = costmatrix_quarter)
dist_quarter_om_rm <- seqdist(States_Wide.seq_quarter_t_prim_adm_RM,
                   method = "OM",
                   indel= 1.0, #Ignored with non OM metrics.
                   sm = costmatrix_quarter_rm)
dist_quarter_om_cens <- seqdist(States_Wide.seq_quarter_t_prim_adm_cens,
                   method = "OM",
                   indel= 1.0,#Ignored with non OM metrics.
                   sm = costmatrix_quarter_cens)
dist_month_om <- seqdist(States_Wide.seq_month_t_prim_adm,
                   method = "OM",
                   indel= 1.0,#Ignored with non OM metrics.
                   sm = costmatrix_month)
dist_month_om_rm <- seqdist(States_Wide.seq_month_t_prim_adm_RM,
                   method = "OM",
                   indel= 1.0,#Ignored with non OM metrics.
                   sm = costmatrix_month_rm)
dist_month_om_cens <- seqdist(States_Wide.seq_month_t_prim_adm_cens,
                   method = "OM",
                   indel= 1.0,#Ignored with non OM metrics.
                   sm = costmatrix_month_cens)

# ---- ** LCS" (Longest Common Subsequence). ----
dist_quarter_lcs <- seqdist(States_Wide.seq_quarter_t_prim_adm,
                      method = "LCS", #"HAM",
                      sm = costmatrix_quarter)
dist_quarter_lcs_rm <- seqdist(States_Wide.seq_quarter_t_prim_adm_RM,
                      method = "LCS", #"HAM",
                      sm = costmatrix_quarter_rm)
dist_quarter_lcs_cens <- seqdist(States_Wide.seq_quarter_t_prim_adm_cens,
                      method = "LCS", #"HAM",
                      sm = costmatrix_quarter_cens)
dist_month_lcs <- seqdist(States_Wide.seq_month_t_prim_adm,
                      method = "LCS", #"HAM",
                      sm = costmatrix_month)
dist_month_lcs_rm <- seqdist(States_Wide.seq_month_t_prim_adm_RM,
                      method = "LCS", #"HAM",
                      sm = costmatrix_month_rm)
dist_month_lcs_cens <- seqdist(States_Wide.seq_month_t_prim_adm_cens,
                      method = "LCS", #"HAM",
                      sm = costmatrix_month_cens)

Tiempo que demora esta sección: 0 minutos

2.a. Clúster jerárquico

Se generó un análisis de clúster jerárquico mediante el método de agrupamiento (Ward.D2) minimiza la suma de las varianzas dentro de cada clúster.

\[ d(A, B) = \sqrt{ \frac{2|A||B|}{|A| + |B|} } \, \cdot ||c_A - c_B|| \] donde: - \(|A|\) y \(|B|\) son los tamaños de los conglomerados - \(x_i\) es un punto de datos en el conglomerado - \(c_A\) es el centroide del conglomerado A - \(c_B\) es el centroide del conglomerado B

om_dist_quarter <- hclust(as.dist(dist_quarter_om), method = "ward.D2")
om_dist_quarter_rm <- hclust(as.dist(dist_quarter_om_rm), method = "ward.D2")

lcs_dist_quarter <- hclust(as.dist(dist_quarter_lcs), method = "ward.D2")
lcs_dist_quarter_rm <- hclust(as.dist(dist_quarter_lcs_rm), method = "ward.D2")

om_dist_quarter_cens <- hclust(as.dist(dist_quarter_om_cens), method = "ward.D2")
lcs_dist_quarter_cens <- hclust(as.dist(dist_quarter_lcs_cens), method = "ward.D2")

om_dist_month <- hclust(as.dist(dist_month_om), method = "ward.D2")
om_dist_month_rm <- hclust(as.dist(dist_month_om_rm), method = "ward.D2")

lcs_dist_month <- hclust(as.dist(dist_month_lcs), method = "ward.D2")
lcs_dist_month_rm <- hclust(as.dist(dist_month_lcs_rm), method = "ward.D2")

om_dist_month_cens <- hclust(as.dist(dist_month_om_cens), method = "ward.D2")
lcs_dist_month_cens <- hclust(as.dist(dist_month_lcs_cens), method = "ward.D2")

Tiempo que demora esta sección: 0.5 minutos

Se generan los dendogramas, que para mejor representación se restringe a un mínimo de de distancias (altura o dismilaridad) de 30. De manera que elementos que se encuentran separados por menos de 30 unidades en la matriz de dissimilaridad se considerará que pertenecen a una misma agrupación, lo que simplifica la visualización.

Trimestral

Dendograma OM- Ward (Corte a 30) s/censura

plot(cut(as.dendrogram(om_dist_quarter), h = 30)$upper, 
     main = NULL, 
     ylab = "Distancia", xlab = "", cex = 0.5)
# recorded_plot <- recordPlot() 
# png("H:/Mi unidad/PERSONAL ANDRES/UCH_salud_publica/asignaturas/un_inv_II/_figs/dendogram_hc_om_trimestral.png", height=6, width=8, res=200, units="in") 
# recorded_plot
# dev.off()

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Dendograma OM- Ward (Corte a 30) s/censura -RM

plot(cut(as.dendrogram(om_dist_quarter_rm), h = 30)$upper, 
     main = NULL, 
     ylab = "Distancia", xlab = "", cex = 0.5)
# recorded_plot <- recordPlot() 
# png("H:/Mi unidad/PERSONAL ANDRES/UCH_salud_publica/asignaturas/un_inv_II/_figs/dendogram_hc_om_trimestral.png", height=6, width=8, res=200, units="in") 
# recorded_plot
# dev.off()

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Dendograma LCS- Ward (Corte a 30) s/censura

plot(cut(as.dendrogram(lcs_dist_quarter), h = 30)$upper, 
     main =NULL, 
     ylab = "Distancia", xlab = "", cex = 0.2)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Dendograma LCS- Ward (Corte a 30) s/censura -RM

plot(cut(as.dendrogram(lcs_dist_quarter_rm), h = 30)$upper, 
     main =NULL, 
     ylab = "Distancia", xlab = "", cex = 0.2)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Dendograma OM- Ward (Corte a 30) c/censura

plot(cut(as.dendrogram(om_dist_quarter_cens), h = 30)$upper, 
     main = NULL,
     ylab = "Distancia", xlab = "", cex = 0.2)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Dendograma LCS- Ward (Corte a 30) c/censura

plot(cut(as.dendrogram(lcs_dist_quarter_cens), h = 30)$upper, 
     main = NULL, 
     ylab = "Distancia", xlab = "", cex = 0.2)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0.5 minutos

• Se puede observar que ambos algoritmos generan separaciones claras en 3 a 5 separaciones que serían más distinguibles.
• En el caso de la región metropolitana, se puede distinguir 2 a 8 conglomerados, aunque 3 son más distinguibles y 5 son razonablemente distinguibles.

Mensual

Dendograma OM- Ward (Corte a 30) s/censura

plot(cut(as.dendrogram(om_dist_month), h = 30)$upper, 
     main = NULL,
     ylab = "Distancia", xlab = "", cex = 0.5)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Dendograma OM- Ward (Corte a 30) s/censura-RM

plot(cut(as.dendrogram(om_dist_month_rm), h = 30)$upper, 
     main = NULL,
     ylab = "Distancia", xlab = "", cex = 0.5)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Dendograma LCS- Ward (Corte a 30) s/censura

plot(cut(as.dendrogram(lcs_dist_month), h = 30)$upper, 
     main = NULL,
     ylab = "Distancia", xlab = "", cex = 0.2)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Dendograma LCS- Ward (Corte a 30) s/censura-RM

plot(cut(as.dendrogram(lcs_dist_month_rm), h = 30)$upper, 
     main = NULL,
     ylab = "Distancia", xlab = "", cex = 0.2)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Dendograma OM- Ward (Corte a 30) c/censura

plot(cut(as.dendrogram(om_dist_month_cens), h = 30)$upper, 
     main = NULL,
     ylab = "Distancia", xlab = "", cex = 0.2)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Dendograma LCS- Ward (Corte a 30) c/censura

plot(cut(as.dendrogram(lcs_dist_month_cens), h = 30)$upper, 
     main = NULL,
     ylab = "Distancia", xlab = "", cex = 0.2)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

• Se repite un patrón similar, aunque en este caso 2 a 3 agrupaciones son más claramente distinguibles en ambos. También se constatan solcuiones de 5, cuando no hay censura, y de 7, cuando se incorpora.
• Para RM, se distinguen de 3 a 5, y también pueden vislumbrarse soluciones de 7 u 8 aunque más cercano a un salto en términos de separaciones.

2.a.1. Métricas de calidad

Se ven rangos de 2 a 15 conglomerados y se comparan sus métricas de calidad.

om_dist_quarter_c <- as.clustrange(om_dist_quarter, diss=as.dist(dist_quarter_om), kvals=2:15, ncluster=15) # this takes some time to run
#summary(om_dist_quarter_c, max.rank=14)
om_dist_quarter_c_rm <- as.clustrange(om_dist_quarter_rm, diss=as.dist(dist_quarter_om_rm), kvals=2:15, ncluster=15) # this takes some time to run
#summary(om_dist_quarter_c_rm, max.rank=14)
om_dist_quarter_cens_c <- as.clustrange(om_dist_quarter_cens, diss=as.dist(dist_quarter_om_cens), kvals=2:15, ncluster=15) # this takes some time to run
#summary(om_dist_quarter_cens_c, max.rank=14)
om_dist_month_c <- as.clustrange(om_dist_month, diss=as.dist(dist_month_om), kvals=2:15, ncluster=15) # this takes some time to run
#summary(om_dist_quarter_c, max.rank=14)
om_dist_month_c_rm <- as.clustrange(om_dist_month_rm, diss=as.dist(dist_month_om_rm), kvals=2:15, ncluster=15) # this takes some time to run
#summary(om_dist_month_c_rm, max.rank=14)
om_dist_month_cens_c <- as.clustrange(om_dist_month_cens, diss=as.dist(dist_month_om_cens), kvals=2:15, ncluster=15) # this takes some time to run
#summary(om_dist_month_cens_c, max.rank=14)

lcs_dist_quarter_c <- as.clustrange(lcs_dist_quarter, diss=as.dist(dist_quarter_lcs), kvals=2:15, ncluster=15) # this takes some time to run
#summary(lcs_dist_quarter_c, max.rank=14)
lcs_dist_quarter_c_rm <- as.clustrange(lcs_dist_quarter_rm, diss=as.dist(dist_quarter_lcs_rm), kvals=2:15, ncluster=15) # this takes some time to run
#summary(lcs_dist_quarter_c_rm, max.rank=14)
lcs_dist_quarter_cens_c <- as.clustrange(lcs_dist_quarter_cens, diss= as.dist(dist_quarter_lcs_cens), kvals=2:15, ncluster=15) # this takes some time to run
#summary(lcs_dist_quarter_cens_c, max.rank=14)
lcs_dist_month_c <- as.clustrange(lcs_dist_month, diss=as.dist(dist_month_lcs), kvals=2:15, ncluster=15) # this takes some time to run
#summary(lcs_dist_quarter_c, max.rank=14)
lcs_dist_month_c_rm <- as.clustrange(lcs_dist_month_rm, diss=as.dist(dist_month_lcs_rm), kvals=2:15, ncluster=15) # this takes some time to run
#summary(lcs_dist_month_c_rm, max.rank=14)
lcs_dist_month_cens_c <- as.clustrange(lcs_dist_month_cens, diss=as.dist(dist_month_lcs_cens), kvals=2:15, ncluster=15) # this takes some time to run
#summary(lcs_dist_month_cens_c, max.rank=14)

Tiempo que demora esta sección: 0 minutos

El average silhouette width ASW (Anchura de la Silueta Promedio) mide la coherencia de los elementos dentro de los clústeres. Se calcula como la diferencia entre la distancia promedio de un punto a todos los puntos en su clúster y la distancia mínima promedio a todos los puntos en cualquier otro clúster. Los valores oscilan entre -1 y 1, donde un valor cercano a 1 indica que el punto está bien agrupado, un valor cercano a 0 indica que el punto está en el borde del clúster y un valor negativo indica que el punto puede estar mal agrupado.

El Hubert Gamma HG (estadística Gamma de Hubert) es un índice que mide la correlación entre la matriz de disimilitud original y la matriz de disimilitud generada a partir del dendrograma del clúster. Un valor alto de la estadística Gamma indica una buena correspondencia entre las dos matrices, lo que sugiere una estructura de clúster fuerte.

El C de Hubert HC (Estadística C de Hubert) es similar a la estadística Gamma de Hubert, pero se centra en la evaluación de la calidad de un solo clúster en lugar de la estructura de clúster completa. Mide la proporción de pares de puntos que están en el mismo clúster en la partición verdadera y en la partición obtenida por el algoritmo de agrupamiento. Un valor alto indica una buena correspondencia entre las particiones.

El point biserial correlation PBC (Correlación Biserial Puntual) es un índice que mide la correlación entre una variable continua y una variable binaria que indica la pertenencia a un clúster (0 o 1). En el contexto del análisis de clúster, se utiliza para evaluar la calidad de la separación entre clústeres. Un valor alto de PBC indica que los clústeres están bien separados, lo que sugiere una estructura de clúster fuerte.

Visualizamos los índices de calidad estandarizados, ya sea en magnitudes brutas o estandarizadas (std).

Trimestral

par(mfrow =c(1,2)) 
plot(om_dist_quarter_c, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Trimestral")
abline(v=5, col="#666666", lty="longdash", lwd = 2)
abline(v=9, col="#666666", lty="longdash", lwd = 2)
plot(om_dist_quarter_c, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Trimestral (std)")
abline(v=5, col="#666666", lty="longdash", lwd = 2)
abline(v=9, col="#666666", lty="longdash", lwd = 2)
#pamRange_month_lcs$stats %>% data.frame() %>% dplyr::select("ASW","HC", "HG", "PBC") %>% knitr::kable("markdown")

Índices de calidad (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

• De 5 a 9 cluster parece haber un ajuste y parsimonia adecuados. Particular atención requieren las soluciones de 5 a 6 cluster.

Trimestral (LCS)

par(mfrow =c(1,2)) 
plot(lcs_dist_quarter_c, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral")
abline(v=2, col="#666666", lty="longdash", lwd = 2)
abline(v=9, col="#666666", lty="longdash", lwd = 2)
abline(v=11, col="#666666", lty="longdash", lwd = 2)
plot(lcs_dist_quarter_c, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral (std)")
abline(v=2, col="#666666", lty="longdash", lwd = 2)
abline(v=9, col="#666666", lty="longdash", lwd = 2)
abline(v=11, col="#666666", lty="longdash", lwd = 2)

Índices de calidad (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

• La solución de 2 conglomerados merece especial atención, junto con la de 9 conglomerados, para evitar simplificar. No obstante una solución de 11 conglomerados también obtiene métricas de calidad.

Trimestral (c/ censura)

par(mfrow =c(1,2)) 
plot(om_dist_quarter_cens_c, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Trimestral (c/ censura)")
abline(v=2, col="#666666", lty="longdash", lwd = 2)
abline(v=9, col="#666666", lty="longdash", lwd = 2)
abline(v=11, col="#666666", lty="longdash", lwd = 2)
plot(om_dist_quarter_cens_c, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Trimestral (std) (c/ censura)")
abline(v=2, col="#666666", lty="longdash", lwd = 2)
abline(v=9, col="#666666", lty="longdash", lwd = 2)
abline(v=11, col="#666666", lty="longdash", lwd = 2)

Índices de calidad (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

• Especial atención merece la solcuión de 2 conglomerados, seguido por la solución de 11. Por otra parte, una solución de 8-9 conglomerados también muestra un balance aunque entre simplicidad y complejidad, aunque los conglomerados no sean del todo distinguibles.

Trimestral (LCS) (c/ censura)

par(mfrow =c(1,2)) 
plot(lcs_dist_quarter_cens_c, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral (c/ censura)")
abline(v=2, col="#666666", lty="longdash", lwd = 2)
plot(lcs_dist_quarter_cens_c, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral (std) (c/ censura)")
abline(v=2, col="#666666", lty="longdash", lwd = 2)

Índices de calidad (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

La solución de 2 cluster es la de mejor calidad.

Trimestral-RM

par(mfrow =c(1,2)) 
plot(om_dist_quarter_c_rm, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "bottomright", main = "OM Trimestral")
abline(v=4, col="#666666", lty="longdash", lwd = 2)
abline(v=5, col="#666666", lty="longdash", lwd = 2)
plot(om_dist_quarter_c_rm, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "bottomright", main = "OM Trimestral (std)")
abline(v=4, col="#666666", lty="longdash", lwd = 2)
abline(v=5, col="#666666", lty="longdash", lwd = 2)

Índices de calidad (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

• La solución de 4 o 5 conglomerados parece tener buenos índices de calidad y un balance entre calidad y complejidad.

Trimestral (LCS)-RM

par(mfrow =c(1,2)) 
plot(lcs_dist_quarter_c_rm, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral")
 abline(v=5, col="#666666", lty="longdash", lwd = 2)

plot(lcs_dist_quarter_c_rm, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral (std)")
 abline(v=5, col="#666666", lty="longdash", lwd = 2)

Índices de calidad (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

• La solución de 5 cluster parecen presentar un buen balance entre cohesión, correspondencia con los datos originales y separación, sumado a que es menos compleja que otras soluciones con mejor calidad.

Mensual

par(mfrow =c(1,2)) 
plot(om_dist_month_c, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", 
     lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual")
 abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=8, col="#666666", lty="longdash", lwd = 2)
plot(om_dist_month_c, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual (std)")
 abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=8, col="#666666", lty="longdash", lwd = 2)

Tiempo que demora esta sección: 0 minutos

• La solución de 2 y 8 a 9 cluster merecen especial atención. La primera maximiza la separación, aunque las de 8 a 9 permiten hacer mayores distinciones más detalladas con una segmentación de separación razonable.

Mensual (LCS)

par(mfrow =c(1,2)) 
plot(lcs_dist_month_c, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", 
     lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual")
  abline(v=4, col="#666666", lty="longdash", lwd = 2)
plot(lcs_dist_month_c, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual (std)")
 abline(v=4, col="#666666", lty="longdash", lwd = 2)

Tiempo que demora esta sección: 0 minutos

• La mejor solución parece ser el de 2 y 3 cluster. Sin embargo, es razonable considerar un modelo más complejo de 4 cluster con adecuadas métricas de calidad.

Mensual (c/ censura)

par(mfrow =c(1,2)) 
plot(om_dist_month_cens_c, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lty=1, lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual (c/ censura)")
abline(v=2, col="#666666", lty="longdash", lwd = 2)
abline(v=3, col="#666666", lty="longdash", lwd = 2)
plot(om_dist_month_cens_c, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lty=1, lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual (std) (c/ censura)")
abline(v=2, col="#666666", lty="longdash", lwd = 2)
abline(v=3, col="#666666", lty="longdash", lwd = 2)

Tiempo que demora esta sección: 0 minutos

• La mejor solución parece ser el de 2, seguido por el de 3 clusters, aunque el modelo de 7 ofrece una mayor complejidad pero tiene valores subóptimos en lo que refiere a las métricas de calidad.

Mensual (LCS) (c/ censura)

par(mfrow =c(1,2)) 
plot(lcs_dist_month_cens_c, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lty=1, lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual (c/ censura)")
 abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=3, col="#666666", lty="longdash", lwd = 2)
plot(lcs_dist_month_cens_c, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lty=1, lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual (std) (c/ censura)")
 abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=3, col="#666666", lty="longdash", lwd = 2)

Tiempo que demora esta sección: 0 minutos

• La solución de 2 clúster es la única que tiene niveles óptimos de ASW. Por otra parte, la solución de 3 clúster tiene ajustes razonables. Por último, las soluciones de 4 y 6 conglomerados presentan buenas métricas de calidad, aunque valores ASW bajos.

Mensual-RM

par(mfrow =c(1,2)) 
plot(om_dist_month_c_rm, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "bottomright", main = "OM Trimestral")
 abline(v=5, col="#666666", lty="longdash", lwd = 2)
# abline(v=5, col="#666666", lty="longdash", lwd = 2)
plot(om_dist_month_c_rm, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "bottomright", main = "OM Trimestral (std)")
 abline(v=5, col="#666666", lty="longdash", lwd = 2)
# abline(v=5, col="#666666", lty="longdash", lwd = 2)

Índices de calidad (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

• Las soluciones de 5 y 6 conglomerados obtienen niveles de caldiad aceptables en términos de pertenencia de los miembros al conglomerados y otras métricas de calidad.

Mensual (LCS)-RM

par(mfrow =c(1,2)) 
plot(lcs_dist_month_c_rm, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral")
 abline(v=5, col="#666666", lty="longdash", lwd = 2)

plot(lcs_dist_month_c_rm, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral (std)")
 abline(v=5, col="#666666", lty="longdash", lwd = 2)

Índices de calidad (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

• Si bien los valores de ASW son menores al umbral, el modelo con mejor compromiso entre complejidad y calidad es la solución de 5 conglomerados.

2.b. Partitioning around medoids

Un modelo de generación de conglomerados más flexible que el aglomerativo jerárquico y el algoritmo de k-medias. Este método busca secuencias representativas en los datos, llamados medoides (medoids) y crean conglomerados mediante la asociación de cada secuencia a su medoide más cercano basado en la matriz de distancia. El fin es minimizar la suma de dissimilaridades de las observaciones a su secuenca representativa más cercana. Un medoid se define como la observación de un grupo que tiene la suma ponderada más pequeña de distancias de las otras observaciones en su grupo.

##Look at cluster quality for a variety of cluster solutions
pamRange_quarter_om <- wcKMedRange(dist_quarter_om, kvals=2:15) # this takes a while to run
# summary(pamRange_quarter_om, max.rank=14)
pamRange_quarter_om_rm <- wcKMedRange(dist_quarter_om_rm, kvals=2:15) # this takes a while to run
# summary(pamRange_quarter_om_rm, max.rank=14)
pamRange_quarter_om_cens <- wcKMedRange(dist_quarter_om_cens, kvals=2:15) # this takes a while to run
# summary(pamRange_quarter_om_cens, max.rank=14)
pamRange_quarter_lcs <- wcKMedRange(dist_quarter_lcs, kvals=2:15) # this takes a while to run
# summary(pamRange_quarter_lcs, max.rank=14)
pamRange_quarter_lcs_rm <- wcKMedRange(dist_quarter_lcs_rm, kvals=2:15) # this takes a while to run
# summary(pamRange_quarter_lcs_rm, max.rank=14)
pamRange_quarter_lcs_cens <- wcKMedRange(dist_quarter_lcs_cens, kvals=2:15) # this takes a while to run
# summary(pamRange_quarter_lcs_cens, max.rank=14)

pamRange_month_om <- wcKMedRange(dist_month_om, kvals=2:15) # this takes a while to run
# summary(pamRange_month_om, max.rank=14)
pamRange_month_om_rm <- wcKMedRange(dist_month_om_rm, kvals=2:15) # this takes a while to run
# summary(pamRange_month_om_rm, max.rank=14)
pamRange_month_om_cens <- wcKMedRange(dist_month_om_cens, kvals=2:15) # this takes a while to run
# summary(pamRange_month_om_cens, max.rank=14)
pamRange_month_lcs <- wcKMedRange(dist_month_lcs, kvals=2:15) # this takes a while to run
# summary(pamRange_month_lcs, max.rank=14)
pamRange_month_lcs_rm <- wcKMedRange(dist_month_lcs_rm, kvals=2:15) # this takes a while to run
# summary(pamRange_month_lcs_rm, max.rank=14)
pamRange_month_lcs_cens <- wcKMedRange(dist_month_lcs_cens, kvals=2:15) # this takes a while to run
# summary(pamRange_month_lcs_cens, max.rank=14)

Tiempo que demora esta sección: 0.1 minutos

Visualizamos los índices de ajuste brutos y estandarizados (std).

Trimestral

par(mfrow =c(1,2)) 
plot(pamRange_quarter_om, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "right", main = "OM Trimestral")
  abline(v=4, col="#666666", lty="longdash", lwd = 2)
  abline(v=6, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_quarter_om, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Trimestral (std)")
  abline(v=4, col="#666666", lty="longdash", lwd = 2)
  abline(v=6, col="#666666", lty="longdash", lwd = 2)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

• La solución de 4 y 6 o 7 cluster parecen tener buenos índices de calidad. De todas formas, los índices ASW se encuentran en niveles que reflejan buena calidad, 6 - 7 cluster reflejan de mejor forma las distancias entre los puntos.

Trimestral (LCS)

par(mfrow =c(1,2)) 
plot(pamRange_quarter_lcs, stat = c("ASW","HC", "HG", "PBC"), xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral")
  abline(v=3, col="#666666", lty="longdash", lwd = 2)
  abline(v=6, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_quarter_lcs, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral (std)")
  abline(v=3, col="#666666", lty="longdash", lwd = 2)
  abline(v=6, col="#666666", lty="longdash", lwd = 2)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

• La solución de 3 a 6 cluster parecen mostrar mejores índices de calidad. De todas formas, las diferencias son pequeñas entre ellos, con especial atención a un número de 5 conglomerados.

Trimestral (c/censura)

par(mfrow =c(1,2)) 
plot(pamRange_quarter_om_cens, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Trimestral (c/ censura)")
 abline(v=7, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_quarter_om_cens, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Trimestral (std) (c/ censura)")
 abline(v=7, col="#666666", lty="longdash", lwd = 2)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

• La solución de 7 cluster parece tener mejores índices comparativos, aunque valores subóptimos de ASW. No obstante, la solución de 2 cluster es simple y también tiene valores subóptimos.

Trimestral (LCS) (c/censura)

par(mfrow =c(1,2)) 
plot(pamRange_quarter_lcs_cens, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral (c/ censura)")
abline(v=2, col="#666666", lty="longdash", lwd = 2)
abline(v=6, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_quarter_lcs_cens, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral (std) (c/ censura)")
abline(v=2, col="#666666", lty="longdash", lwd = 2)
abline(v=6, col="#666666", lty="longdash", lwd = 2)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

• La solución de 2 conglomerados presenta mejores índices de ajuste, aunque en general bastante bajos. Si se prioriza complejidad, una solución que asuma 6 conglomerados sería razonable, aunque todos con valores subóptimos en ASW.

Trimestral-RM

par(mfrow =c(1,2)) 
plot(pamRange_quarter_om_rm, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "right", main = "OM Trimestral")
  abline(v=7, col="#666666", lty="longdash", lwd = 2)
 # abline(v=6, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_quarter_om_rm, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Trimestral (std)")
  abline(v=7, col="#666666", lty="longdash", lwd = 2)
 # abline(v=6, col="#666666", lty="longdash", lwd = 2)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

• La solución de 7 conglomerados presenta mejores ajustes a niveles relativos, aunque las diferencias son bastante pequeñas. La solución de 2 conglomerados presenta buenos niveles de calidad.

Trimestral (LCS)-RM

par(mfrow =c(1,2)) 
plot(pamRange_quarter_lcs_rm, stat = c("ASW","HC", "HG", "PBC"), xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "bottomright", main = "LCS Trimestral")
  abline(v=5, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_quarter_lcs_rm, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral (std)")
  abline(v=5, col="#666666", lty="longdash", lwd = 2)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

• Una solución de 5 conglomerados parece ser parsmoniosa y tener mejores índices de calidad, ya que los conglomeardos logran separar mejor.

Mensual

par(mfrow =c(1,2)) 
plot(pamRange_month_om, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual")
# abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=6, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_month_om, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual (std)")
# abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=6, col="#666666", lty="longdash", lwd = 2)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

• Las mejores soluciones son las de 6 conglomerados, aunque con valores subóptimos en ASW.

Mensual (LCS)

par(mfrow =c(1,2)) 
plot(pamRange_month_lcs, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual")
# abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=6, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_month_lcs, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual (std)")
# abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=6, col="#666666", lty="longdash", lwd = 2)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

• Las soluciones de 6 conglomerados parecen tener mejores índices de calidad, no obstante, se constatan valores subóptimos en ASW.

Mensual (c/censura)

par(mfrow =c(1,2)) 
plot(pamRange_month_om_cens, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual (c/ censura)")
 abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=4, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_month_om_cens, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual (std) (c/ censura)")
 abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=4, col="#666666", lty="longdash", lwd = 2)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

• Las soluciones de 2 y 4 cluster parecen ser las mejores en términos de calidad, aunque con valores subóptimos en ASW, por lo que podrían haber componentes que no calcen en los conglomerados.

Mensual (LCS) (c/censura)

par(mfrow =c(1,2)) 
plot(pamRange_month_lcs_cens, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual (c/ censura)")
  abline(v=2, col="#666666", lty="longdash", lwd = 2)
  abline(v=4, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_month_lcs_cens, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual (std) (c/ censura)")
  abline(v=2, col="#666666", lty="longdash", lwd = 2)
  abline(v=4, col="#666666", lty="longdash", lwd = 2)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

• La solución de 2 clúster es la única que parece medianamente razonable en términos de calidad. Le sigue la de 4, aunque todas con bajos valores de calidad en general.

Mensual-RM

par(mfrow =c(1,2)) 
plot(pamRange_month_om_rm, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual")
 abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=4, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_month_om_rm, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual (std)")
 abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=4, col="#666666", lty="longdash", lwd = 2)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

• La solución de 2 y 4 conglomerados consigue un ajuste relativamente mejor, siendo capaz de incorporar mayor complejidad aunque con valores levemente subóptimos en ASW.

Mensual (LCS)-RM

par(mfrow =c(1,2)) 
plot(pamRange_month_lcs_rm, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual")
abline(v=4, col="#666666", lty="longdash", lwd = 2)
abline(v=5, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_month_lcs_rm, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual (std)")
 abline(v=4, col="#666666", lty="longdash", lwd = 2)
 abline(v=5, col="#666666", lty="longdash", lwd = 2)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

• La solución de 4 y 5 conglomerados parece ser la que mejores índices de calidad presentan, aunque subóptimos en ASW.

Información de la sesión

message(paste0("R library: ", Sys.getenv("R_LIBS_USER")))

R library: C:/R/win-library/4.4

message(paste0("Date: ",withr::with_locale(new = c('LC_TIME' = 'C'), code =Sys.time())))

Date: 2025-03-18 16:42:45.889208

message(paste0("Editor context: ", getwd()))

Editor context: H:/Mi unidad/PERSONAL ANDRES/UCH_salud_publica/asignaturas/un_inv_II

Tiempo que demora esta sección: 0 minutos

sesion_info <- devtools::session_info()

Warning in system2(“quarto”, “-V”, stdout = TRUE, env = paste0(“TMPDIR=”, : el comando ejecutado ‘“quarto” TMPDIR=C:/Users/andre/AppData/Local/Temp/RtmpgNXGUF/file6f7c617b882 -V’ tiene el estatus 1

dplyr::select(
  tibble::as_tibble(sesion_info$packages),
  c(package, loadedversion, source)
) %>% 
 knitr::kable(caption = "R packages", format = "html",
      col.names = c("Row number", "Package", "Version"),
    row.names = FALSE,
      align = c("c", "l", "r")) %>% 
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12) %>% 
  kableExtra::scroll_box(width = "100%", height = "375px")  

R packages

Row number	Package	Version
boot	1.3-31	CRAN (R 4.4.1)
cachem	1.1.0	CRAN (R 4.4.1)
cli	3.6.4	CRAN (R 4.4.1)
cluster	2.1.8.1	CRAN (R 4.4.1)
codetools	0.2-20	CRAN (R 4.4.1)
colorspace	2.1-1	CRAN (R 4.4.1)
data.table	1.17.0	CRAN (R 4.4.1)
devtools	2.4.5	CRAN (R 4.4.1)
digest	0.6.37	CRAN (R 4.4.0)
doFuture	1.0.1	CRAN (R 4.4.1)
doParallel	1.0.17	CRAN (R 4.4.1)
dplyr	1.1.4	CRAN (R 4.4.1)
ellipsis	0.3.2	CRAN (R 4.4.1)
evaluate	1.0.3	CRAN (R 4.4.1)
factoextra	1.0.7	CRAN (R 4.4.1)
farver	2.1.2	CRAN (R 4.4.1)
fastcluster	1.2.6	CRAN (R 4.4.1)
fastmap	1.2.0	CRAN (R 4.4.1)
forcats	1.0.0	CRAN (R 4.4.1)
foreach	1.5.2	CRAN (R 4.4.1)
fs	1.6.5	CRAN (R 4.4.2)
future	1.34.0	CRAN (R 4.4.1)
future.apply	1.11.3	CRAN (R 4.4.1)
generics	0.1.3	CRAN (R 4.4.1)
ggplot2	3.5.1	CRAN (R 4.4.1)
ggrepel	0.9.6	CRAN (R 4.4.1)
ggseqplot	0.8.5	CRAN (R 4.4.1)
globals	0.16.3	CRAN (R 4.4.1)
glue	1.8.0	CRAN (R 4.4.2)
gridExtra	2.3	CRAN (R 4.4.1)
gtable	0.3.6	CRAN (R 4.4.1)
haven	2.5.4	CRAN (R 4.4.1)
hms	1.1.3	CRAN (R 4.4.1)
htmltools	0.5.8.1	CRAN (R 4.4.1)
htmlwidgets	1.6.4	CRAN (R 4.4.1)
httpuv	1.6.15	CRAN (R 4.4.1)
iterators	1.0.14	CRAN (R 4.4.1)
jsonlite	1.9.1	CRAN (R 4.4.1)
kableExtra	1.4.0	CRAN (R 4.4.1)
knitr	1.49	CRAN (R 4.4.2)
labeling	0.4.3	CRAN (R 4.4.1)
later	1.4.1	CRAN (R 4.4.2)
lattice	0.22-6	CRAN (R 4.4.1)
lifecycle	1.0.4	CRAN (R 4.4.1)
listenv	0.9.1	CRAN (R 4.4.1)
lubridate	1.9.4	CRAN (R 4.4.1)
magrittr	2.0.3	CRAN (R 4.4.1)
MASS	7.3-60.2	CRAN (R 4.4.1)
Matrix	1.7-0	CRAN (R 4.4.1)
memoise	2.0.1	CRAN (R 4.4.1)
mgcv	1.9-1	CRAN (R 4.4.1)
mime	0.12	CRAN (R 4.4.1)
miniUI	0.1.1.1	CRAN (R 4.4.1)
munsell	0.5.1	CRAN (R 4.4.1)
NbClust	3.0.1	CRAN (R 4.4.1)
nlme	3.1-164	CRAN (R 4.4.1)
nnet	7.3-19	CRAN (R 4.4.1)
pacman	0.5.1	CRAN (R 4.4.1)
parallelly	1.42.0	CRAN (R 4.4.1)
patchwork	1.3.0	CRAN (R 4.4.1)
permute	0.9-7	CRAN (R 4.4.1)
pillar	1.10.1	CRAN (R 4.4.1)
pkgbuild	1.4.6	CRAN (R 4.4.1)
pkgconfig	2.0.3	CRAN (R 4.4.1)
pkgload	1.4.0	CRAN (R 4.4.2)
profvis	0.4.0	CRAN (R 4.4.2)
progressr	0.15.1	CRAN (R 4.4.1)
promises	1.3.2	CRAN (R 4.4.2)
purrr	1.0.4	CRAN (R 4.4.1)
R6	2.6.1	CRAN (R 4.4.1)
rbibutils	2.3	CRAN (R 4.4.1)
RColorBrewer	1.1-3	CRAN (R 4.4.1)
Rcpp	1.0.14	CRAN (R 4.4.1)
Rdpack	2.6.2	CRAN (R 4.4.1)
readr	2.1.5	CRAN (R 4.4.1)
remotes	2.5.0	CRAN (R 4.4.1)
rlang	1.1.5	CRAN (R 4.4.1)
rmarkdown	2.29	CRAN (R 4.4.2)
rstudioapi	0.17.1	CRAN (R 4.4.2)
scales	1.3.0	CRAN (R 4.4.1)
sessioninfo	1.2.3	CRAN (R 4.4.1)
shiny	1.10.0	CRAN (R 4.4.1)
stringi	1.8.4	CRAN (R 4.4.1)
stringr	1.5.1	CRAN (R 4.4.1)
survival	3.6-4	CRAN (R 4.4.1)
svglite	2.1.3	CRAN (R 4.4.1)
systemfonts	1.2.1	CRAN (R 4.4.1)
tibble	3.2.1	CRAN (R 4.4.1)
tidyr	1.3.1	CRAN (R 4.4.1)
tidyselect	1.2.1	CRAN (R 4.4.1)
tidyverse	2.0.0	CRAN (R 4.4.3)
timechange	0.3.0	CRAN (R 4.4.1)
Tmisc	1.0.1	CRAN (R 4.4.1)
TraMineR	2.2-11	CRAN (R 4.4.1)
TraMineRextras	0.6.8	CRAN (R 4.4.1)
tzdb	0.4.0	CRAN (R 4.4.1)
urlchecker	1.0.1	CRAN (R 4.4.1)
usethis	3.1.0	CRAN (R 4.4.2)
utf8	1.2.4	CRAN (R 4.4.1)
vctrs	0.6.5	CRAN (R 4.4.1)
vegan	2.6-10	CRAN (R 4.4.1)
vegclust	2.0.2	CRAN (R 4.4.1)
viridisLite	0.4.2	CRAN (R 4.4.1)
WeightedCluster	1.8-1	CRAN (R 4.4.1)
withr	3.0.2	CRAN (R 4.4.2)
xfun	0.51	CRAN (R 4.4.1)
xml2	1.3.7	CRAN (R 4.4.1)
xtable	1.8-4	CRAN (R 4.4.1)
yaml	2.3.10	CRAN (R 4.4.1)

Tiempo que demora esta sección: 0 minutos

reticulate::py_list_packages()%>% 
 knitr::kable(caption = "Python packages", format = "html",
      col.names = c("Package", "Version", "Requirement"),
    row.names = FALSE,
      align = c("c", "l", "r", "r"))%>% 
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12) %>% 
  kableExtra::scroll_box(width = "100%", height = "375px")  

Python packages

Package	Version	Requirement
absl-py	2.1.0	absl-py==2.1.0
asttokens	2.4.1	asttokens==2.4.1
astunparse	1.6.3	astunparse==1.6.3
audioconverter	2.0.3	audioconverter==2.0.3
autograd	1.6.2	autograd==1.6.2
autograd-gamma	0.5.0	autograd-gamma==0.5.0
beautifulsoup4	4.12.3	beautifulsoup4==4.12.3
Brotli	1.1.0	Brotli==1.1.0
certifi	2023.11.17	certifi==2023.11.17
cffi	1.16.0	cffi==1.16.0
charset-normalizer	3.3.2	charset-normalizer==3.3.2
clarabel	0.9.0	clarabel==0.9.0
click	8.1.7	click==8.1.7
cloudpickle	3.0.0	cloudpickle==3.0.0
colorama	0.4.6	colorama==0.4.6
comm	0.2.1	comm==0.2.1
contourpy	1.2.0	contourpy==1.2.0
cvxopt	1.3.2	cvxopt==1.3.2
cvxpy	1.5.2	cvxpy==1.5.2
cycler	0.12.1	cycler==0.12.1
debugpy	1.8.0	debugpy==1.8.0
decorator	4.4.2	decorator==4.4.2
delete-chrome-history-py	0.1.8	delete-chrome-history-py==0.1.8
easyocr	1.7.1	easyocr==1.7.1
ecos	2.0.13	ecos==2.0.13
editdistance	0.8.1	editdistance==0.8.1
efficientnet	1.0.0	efficientnet==1.0.0
essential-generators	1.0	essential-generators==1.0
et-xmlfile	1.1.0	et-xmlfile==1.1.0
executing	2.0.1	executing==2.0.1
fancyimpute	0.7.0	fancyimpute==0.7.0
ffmpeg	1.4	ffmpeg==1.4
ffmpeg-python	0.2.0	ffmpeg-python==0.2.0
filedir	0.0.3	filedir==0.0.3
filelock	3.13.1	filelock==3.13.1
flatbuffers	24.3.25	flatbuffers==24.3.25
fonttools	4.47.2	fonttools==4.47.2
formulaic	1.0.1	formulaic==1.0.1
fsspec	2023.12.2	fsspec==2023.12.2
future	0.18.3	future==0.18.3
gast	0.6.0	gast==0.6.0
git-filter-repo	2.45.0	git-filter-repo==2.45.0
google-pasta	0.2.0	google-pasta==0.2.0
graphviz	0.20.3	graphviz==0.20.3
grpcio	1.65.4	grpcio==1.65.4
gTTS	2.5.1	gTTS==2.5.1
h5py	3.11.0	h5py==3.11.0
idna	3.6	idna==3.6
imageio	2.34.2	imageio==2.34.2
imageio-ffmpeg	0.5.1	imageio-ffmpeg==0.5.1
imgaug	0.4.0	imgaug==0.4.0
iniconfig	2.0.0	iniconfig==2.0.0
interface-meta	1.3.0	interface-meta==1.3.0
ipykernel	6.29.5	ipykernel==6.29.5
ipython	8.20.0	ipython==8.20.0
jedi	0.19.1	jedi==0.19.1
Jinja2	3.1.3	Jinja2==3.1.3
joblib	1.4.0	joblib==1.4.0
jupyter_client	8.6.0	jupyter_client==8.6.0
jupyter_core	5.7.1	jupyter_core==5.7.1
keras	3.4.1	keras==3.4.1
Keras-Applications	1.0.8	Keras-Applications==1.0.8
keras-ocr	0.9.3	keras-ocr==0.9.3
kiwisolver	1.4.5	kiwisolver==1.4.5
knnimpute	0.1.0	knnimpute==0.1.0
lazy_loader	0.4	lazy_loader==0.4
libclang	18.1.1	libclang==18.1.1
lifelines	0.28.0	lifelines==0.28.0
llvmlite	0.41.1	llvmlite==0.41.1
Markdown	3.6	Markdown==3.6
markdown-it-py	3.0.0	markdown-it-py==3.0.0
MarkupSafe	2.1.4	MarkupSafe==2.1.4
matplotlib	3.8.2	matplotlib==3.8.2
matplotlib-inline	0.1.6	matplotlib-inline==0.1.6
mdurl	0.1.2	mdurl==0.1.2
mido	1.3.3	mido==1.3.3
ml-dtypes	0.4.0	ml-dtypes==0.4.0
more-itertools	10.2.0	more-itertools==10.2.0
moviepy	1.0.3	moviepy==1.0.3
mpmath	1.3.0	mpmath==1.3.0
multipledispatch	1.0.0	multipledispatch==1.0.0
mutagen	1.47.0	mutagen==1.47.0
namex	0.0.8	namex==0.0.8
natsort	8.4.0	natsort==8.4.0
nest-asyncio	1.5.9	nest-asyncio==1.5.9
networkx	3.2.1	networkx==3.2.1
ninja	1.11.1.1	ninja==1.11.1.1
nose	1.3.7	nose==1.3.7
numba	0.58.1	numba==0.58.1
numexpr	2.10.0	numexpr==2.10.0
numpy	1.26.3	numpy==1.26.3
openai-whisper	20231117	openai-whisper==20231117
opencv-python	4.10.0.84	opencv-python==4.10.0.84
opencv-python-headless	4.10.0.84	opencv-python-headless==4.10.0.84
openpyxl	3.1.4	openpyxl==3.1.4
opt-einsum	3.3.0	opt-einsum==3.3.0
optree	0.12.1	optree==0.12.1
osqp	0.6.5	osqp==0.6.5
packaging	23.2	packaging==23.2
pandas	2.2.0	pandas==2.2.0
pandas-flavor	0.6.0	pandas-flavor==0.6.0
parso	0.8.3	parso==0.8.3
patsy	0.5.6	patsy==0.5.6
pillow	10.2.0	pillow==10.2.0
platformdirs	4.1.0	platformdirs==4.1.0
pluggy	1.5.0	pluggy==1.5.0
polars	1.9.0	polars==1.9.0
proglog	0.1.10	proglog==0.1.10
prompt-toolkit	3.0.43	prompt-toolkit==3.0.43
protobuf	4.25.4	protobuf==4.25.4
psutil	5.9.8	psutil==5.9.8
pure-eval	0.2.2	pure-eval==0.2.2
pyarrow	15.0.0	pyarrow==15.0.0
pyclipper	1.3.0.post5	pyclipper==1.3.0.post5
pycparser	2.22	pycparser==2.22
pycryptodomex	3.20.0	pycryptodomex==3.20.0
pydotplus	2.0.2	pydotplus==2.0.2
pydub	0.24.1	pydub==0.24.1
Pygments	2.17.2	Pygments==2.17.2
pyjanitor	0.26.0	pyjanitor==0.26.0
PyMuPDF	1.24.9	PyMuPDF==1.24.9
PyMuPDFb	1.24.9	PyMuPDFb==1.24.9
pyparsing	3.1.1	pyparsing==3.1.1
PyPDF2	3.0.1	PyPDF2==3.0.1
pyreadr	0.5.0	pyreadr==0.5.0
pytesseract	0.3.10	pytesseract==0.3.10
pytest	8.3.1	pytest==8.3.1
python-bidi	0.6.0	python-bidi==0.6.0
python-dateutil	2.8.2	python-dateutil==2.8.2
pytube	15.0.0	pytube==15.0.0
pytube3	9.6.4	pytube3==9.6.4
pytz	2023.3.post1	pytz==2023.3.post1
pywin32	306	pywin32==306
PyYAML	6.0.1	PyYAML==6.0.1
pyzmq	25.1.2	pyzmq==25.1.2
qdldl	0.1.7.post1	qdldl==0.1.7.post1
regex	2023.12.25	regex==2023.12.25
requests	2.32.3	requests==2.32.3
rich	13.7.1	rich==13.7.1
rpy2	3.5.16	rpy2==3.5.16
scikit-image	0.24.0	scikit-image==0.24.0
scikit-learn	1.3.2	scikit-learn==1.3.2
scikit-survival	0.22.2	scikit-survival==0.22.2
scipy	1.11.4	scipy==1.11.4
scs	3.2.6	scs==3.2.6
seaborn	0.13.2	seaborn==0.13.2
semantic-version	2.10.0	semantic-version==2.10.0
setuptools-rust	1.8.1	setuptools-rust==1.8.1
shapely	2.0.5	shapely==2.0.5
six	1.16.0	six==1.16.0
soupsieve	2.5	soupsieve==2.5
SpeechRecognition	3.10.1	SpeechRecognition==3.10.1
spyder-kernels	2.5.2	spyder-kernels==2.5.2
stack-data	0.6.3	stack-data==0.6.3
statsmodels	0.14.1	statsmodels==0.14.1
sympy	1.12	sympy==1.12
target	0.0.11	target==0.0.11
tensorboard	2.17.0	tensorboard==2.17.0
tensorboard-data-server	0.7.2	tensorboard-data-server==0.7.2
tensorflow	2.17.0	tensorflow==2.17.0
tensorflow-intel	2.17.0	tensorflow-intel==2.17.0
tensorflow-io-gcs-filesystem	0.31.0	tensorflow-io-gcs-filesystem==0.31.0
termcolor	2.4.0	termcolor==2.4.0
threadpoolctl	3.4.0	threadpoolctl==3.4.0
tifffile	2024.7.24	tifffile==2024.7.24
tiktoken	0.5.2	tiktoken==0.5.2
torch	2.4.0	torch==2.4.0
torchaudio	2.4.0	torchaudio==2.4.0
torchvision	0.19.0	torchvision==0.19.0
tornado	6.4	tornado==6.4
tqdm	4.66.1	tqdm==4.66.1
traitlets	5.14.1	traitlets==5.14.1
translator	0.0.9	translator==0.0.9
typing_extensions	4.9.0	typing_extensions==4.9.0
tzdata	2023.4	tzdata==2023.4
tzlocal	5.2	tzlocal==5.2
urllib3	2.1.0	urllib3==2.1.0
validators	0.33.0	validators==0.33.0
watchdog	3.0.0	watchdog==3.0.0
wcwidth	0.2.13	wcwidth==0.2.13
websockets	12.0	websockets==12.0
Werkzeug	3.0.3	Werkzeug==3.0.3
whisper	1.1.10	whisper==1.1.10
wrapt	1.16.0	wrapt==1.16.0
xarray	2024.1.1	xarray==2024.1.1
youtube-dl	2021.12.17	youtube-dl==2021.12.17
yt-dlp	2024.7.9	yt-dlp==2024.7.9

Tiempo que demora esta sección: 0 minutos

Salida

save.image(paste0(folder_path,"20240903_25.RData"))

Tiempo que demora esta sección: 0.3 minutos